package Http;
# use strict
#<copyright>
# ----------------------------------------------------------
# Sun Proprietary/Confidential Code
# Copyright 2001, Sun Microsystems, Inc. All rights reserved.
# ----------------------------------------------------------
#</copyright>

#use IO::Socket;
use Socket;
use Html;
use Util;
use MIME::Base64;
use Client;

#  $Id: Http.pm,v 1.15 2004/10/28 23:46:22 jkremer Exp $
#
# $h = Http->new({ log => 0 });
#
use vars qw ($PID $WEBPROC $INVALID_LOGIN $ruser $SESSIONS $CGI);

$PID = undef;
$sockaddr = 'S n a4 x8';
$WEBPROC = "/rashttp";
$VERSION  = "1.1";
$HTTPQ = undef;
$INVALID_LOGIN = "
   You must provide a username and password to use this resource.<br> Either you
   entered this information incorrectly, or your browser does not know how to
   present the credentials required.";

#$0 = "httpi: handling request";

sub reset_login {
  my $renv = System->get_renv();
  my $head = $ENV{FCGI} ? "Status: 401 Unauthorized" : "HTTP/1.0 401 Unauthorized";
  return <<EOF;
$head
Server: rashttp/1.1
MIME-Version: 1.0
Version: 1.0
Date:  Thu, 31 Oct 2002 17:03:33 GMT
WWW-Authenticate: Basic realm="User"
Content-Type: text/html

<h1>Authorization Required</h1>
$INVALID_LOGIN
<hr>
<address>$renv->{GSV_ACRONYM} / $renv->{version}</address>
EOF

}

#
# CALLED BY ras_admin so far, 
# INCLUDE CLIENT AND SERVER-SIDE CODE
#
sub clearCache {
  my($class) = @_;
  Util::Http->goCommand("localhost", "Http::CLEARCACHE", 10, { password => "peer:peer"} );
}

sub CLEARCACHE {
  my($class) = @_;

  $PDM::ConfigFile::CONFIG = undef;
  my($renv) = PDM::ConfigFile->read();
  System->set_renv($renv);
  print "OK\n";
}



%content_types =
  ("html" => "text/html",
    "htm" => "text/html",
    "txt" => "text/plain",
    "gif" => "image/gif",
   "jpeg" => "image/jpeg",
    "jpg" => "image/jpeg",
    "js" =>  "text/html"
  );

#
# <hostname>:7654/rascgi?GO=GUI::Config::site   : new process each time, 
# _RB=<Basic Authentication>
sub cgi {
  my($http) = @_;
  my(%q);
  my $s = $ENV{QUERY_STRING};
  $CGI=1;
  if (!$s) {
	 print "Content-type: text/html\n\nNo Command\n";
    return;
  }
  my ($LID, $httpuser, $httppw);
  my $Q_LIST = &make_list($s);
  foreach my $variables (@$Q_LIST) {
    $OUT = ""; %Q = (); 

    &parse($variables, \%Q, 0);
	 my $opts = \%Q;
	 if (!$LID){
		if ( $opts->{_BA} ){
		  $LID = $opts->{_BA};
		  delete$opts->{_BA};
		  $LID =~ tr#A-Za-z0-9+/##cd;
			 $LID =~ tr#A-Za-z0-9+/# -_#;
				$LID = unpack("u", pack("c", 32+0.75*length($LID)) . $LID);
		  ($httpuser, $httppw) = split(/:/, $LID);
		}
		my $raddr = Util->name2ip($ENV{REMOTE_ADDR});
		my $saddr = Util->name2ip($ENV{SERVER_NAME});
		if (($raddr eq $saddr) || ($raddr eq "127.0.0.1")){
		  $fail = 0;
		}
		else {
		  $fail = Http->validate($httpuser, $httppw, $http);
		}
		if ($fail){
		  print "Content-type: text/html\n\nAuthorization Failed.\n";
		  return;
		}
	 }

    my($done,$fun) = $http->process_url(\%Q, $master, $httprawu, $s);

    print $OUT if ($OUT);
    if ($fun) {
      if (defined(&$fun)) {
        &$fun(\%Q);
      }
    }
  }
}
     

sub unix_file {
  my($class, $PRGMNAME, $HOME) = @_;

  my $ix = rindex($HOME, "/");
  my $short = substr($HOME, $ix+1) if ($ix > 0);

  return "/tmp/rassock_$PRGMNAME$short";
}

sub new {
  my($class, $info) = @_;

  bless($info, "Http");
  $CURRENT_HTTP = $info;
  $SESSIONS = Util->deserialize("web_sessions") || {};

  foreach my $s (keys %$SESSIONS) {
     delete $SESSIONS{$s} if (time - $s->{time}  > 60 * 60 * 12);  # really old
  }
  return $info;
} 

sub close_sessions {
  Util->serialize("web_sessions", $SESSIONS);
  chown 0,1, System->get_home() . "/DATA/web_sessions";
}


sub sock_to_host {
    local($sock) = getpeername(STDIN);

    return (undef, undef, undef) if (!$sock);
    local($AFC, $port, $thataddr, $zero) = unpack($sockaddr, $sock);
    local($ip) = join('.', unpack("C4", $thataddr));
    return ($ip, $port, $ip);
}

sub ht_response {
   ($currentcode, $currentstring) = (@_);
   return if (0+$httpver < 1);

   $rfcdate = scalar gmtime;
   ($dow, $mon, $dt, $tm, $yr) = ($rfcdate =~ m/(...) (...) (..) (..:..:..) (....)/);
   $dt += 0; $yr += 0;
   $rfcdate = "$dow, $dt $mon $yr $tm GMT";

   my($what) = <<"EOF";
HTTP/$httpver $currentcode $currentstring
Server: HTTPi/$VERSION
MIME-Version: 1.0
Version: $httpver
Date: $rfcdate
EOF
    $what =~ s/\n/\r\n/g;
    $OUT .= $what;
    &hthead("Connection: close") if (0+$httpver > 1);
}

sub hthead {
    my($header, $term) = @_;
    return if (0+$httpver < 1);
    $OUT .=  "$header\r\n" . (($term) ? "\r\n" : "");
}

sub htcontent {
    local($what, $ctype, $mode) = (@_);
    ($contentlength) = $mode || length($what);
    &hthead("Content-Length: $contentlength");
    &hthead("Content-Type: $ctype", 1);
    return if ($method eq 'HEAD' || $mode);
    $OUT .= $what;
}

sub error {
  my($http, $no, $err, $text) = @_;
  $OUT = "";
  &ht_response($no, $err);
  &hterror("Error", $text);
}

sub debug {
  my($m) = @_;
  open(D, ">>/tmp/httplog"); print D "$m\n"; close(D);
}
sub debug0 {
  my($m) = @_;
  open(D, ">>/tmp/httplog"); print D $m; close(D);
}

sub css_button {
  return (index($Http::httpua, "MSIE") >= 0 || index($Http::httpua,"Gecko") >= 0);

  # &&  !Http->isNarrow()) ;
}

#
# Mozilla/4.0 (compatible; MSIE 6.0; Windows 95; PalmSource) NetFront/3.0 
# Mozilla/4.0 (PDA; PalmOS/sony/model vrna/Revision:1.1.36 (en)) NetFront/3.0
#
sub isNarrow {
  return index($Http::httpua, "PDA; PalmOS/") > 0;
}

sub isSOAP {
  return $ENV{REQUEST_URI} eq "/ras_soap";
}

sub log {
  my($http) = @_;
  return;

  $date = scalar localtime;
  ($dow, $mon, $dt, $tm, $yr) = ($date =~ m/(...) (...) (..) (..:..:..) (....)/);
  $dt += 0;
  $dt = substr("0$dt", length("0$dt") - 2, 2);
  $date = "$dt/$mon/$yr:$tm +0000"; 

  return if (!$http->{logfile});

  if (open(J, ">>$http->{logfile}")) {
     local $q = $address . (($variables) ? "?$variables" : "");
     $contentlength += 0;
     $contentlength = 0 if ($method eq 'HEAD');
     local ($hostname, $port, $ip) = &sock_to_host();
     $hostname = $hostname || "-";
     $httpuser = $httpuser || "-";
     print J <<"EOF";
$hostname - $httpuser [$date] "$method $q HTTP/$httpver" $currentcode $contentlength "$httpref" "$httpua"
EOF
     close(J); 
  }
}


sub bye { 
  exit; 
}

sub dead {
    &ht_response(500, "Server Error");
    &hterror("Server Error", <<"EOF");
While handling a request for resource $address, the server crashed. Please
attempt to notify the administrators.
<p>Useful(?) debugging information:
<pre>
@_
</pre>
EOF
    &log; 
}

sub http_init {
  $OUT = undef;
  $method = $address = $httpver = $httpref = $httpua = $httpver = undef;
  $httphost = $httpref = $httpua = $httpcl = $httpct = $expect = $httprawu = undef;
  $http_cookie = $http_remuser = $http_lang = $http_ssl = undef;
  $post_data = undef;
  $Html::HEADER_DONE = 0;
  $Html::HEADER2_DONE = 0;
  $Client::HEADER_DONE = 0;
}

sub getRashttpName {
  my $ix2 = rindex($UNIXFILE, "/");
  my $name = substr($UNIXFILE, $ix2+9);
  return $name;
}

# UNIXFILE=/tmp/rassock_rashttp
# UNIXFILE=/tmp/rassock_rashttp.9

sub kill_http {
  my($name) = @_;
  my $D = System->get_home() . "/DATA/pids";
  mkdir $D, 0755 if (!-d $D);
  opendir(O2, $D);
  my @DIRS = readdir(O2); 
  closedir(O2);
  foreach my $d (@DIRS) {
      next if ($d !~ /^$name\.(\d+)$/);
      my $pid = $1;
      unlink "$D/$d";
      kill SIGTERM, $pid;
      debug("rashttp ($name) already running, killing $pid: $!");
  }
}

sub unix_init {
  my($class, $file) = @_;
  my($pid);
  $UNIXFILE = $file;
  my $ix2 = rindex($UNIXFILE, "/");
  my $name = substr($UNIXFILE, $ix2+9);
  my $D = System->get_home() . "/DATA/pids";
  &kill_http($name);

  $PID = "$D/$name.$$";
  open(O, ">$PID"); close(O);

 # $server = IO::Socket::UNIX->new( Type => SOCK_STREAM,
 #                        Local => $UNIXFILE,
 #                        Listen => 1);

  unlink $UNIXFILE;
  my $uaddr = sockaddr_un($UNIXFILE);
  my $proto = getprotobyname('tcp');

  if (!socket(Server, PF_UNIX, SOCK_STREAM, 0) ||
      !bind(Server, $uaddr) || 
      !listen(Server, SOMAXCONN)) {
  # if (!$server) {
    debug("failed on socket ($file): $!");
    exit;
  }
}

sub runFunction {
  my($class, $fun, $q, $post_data, $util) = @_;
  my($pk);
  my $ix2 = rindex($fun, "->");
  if ($ix2 >= 0) {
     $pk = substr($fun, 0 , $ix2); 
     my $method = substr($fun, $ix2+2);
     my $pk0 = $pk;
     $pk0 =~ s/\:\:/\//g;
     require "$pk0.pm";
     if ($pk->can($method)) {
        $pk->$method($q, $post_data, $util);
     } else {
        print Html->text_header();
        print "Function '$fun' not found!<br>";
     }
   } else {
     $ix = rindex($fun, "::");
     if ($ix >= 0) {
       $pk = substr($fun, 0, $ix);
       $pk =~ s/\:\:/\//g;
       require "$pk.pm";

     } else {
       $fun = "main'$fun";
     }
     if (defined(&$fun)) {
        &$fun($q, $post_data, $util);
     } else {
       print Html->text_header();
       print "Function '$fun' not found!<br>";
     }
   }
}
#########################
#  FCGI-LOOP
#########################

sub fcgi_loop {
  my($http, $util, $master) = @_;
  my ($len, $start, $re , $q, $fun);
  my $fcgi_start = time;
  my $renv       = System->get_renv();

  require FCGI;
  while (FCGI::accept() >= 0) {
    &http_init();
    $method        = $ENV{REQUEST_METHOD};
    $address       = $ENV{REQUEST_URI};
    $httpua        = $ENV{HTTP_USER_AGENT};
    $httphost      = $ENV{HTTP_HOST};
    my $ix         = index($httphost, ":");
    if ($ix > 0) {
      $httphost      = substr($httphost, 0, $ix);
    }
    $http_remuser  = $ENV{REMOTE_USER};
    $http_cookie   = $ENV{HTTP_COOKIE};
    $httpver       = "1.0";
    $httprawu      = substr($ENV{Authorization}, 6);

    if ($method =~ /POST/) {  # get POST data
        $len = $ENV{CONTENT_LENGTH}; 
        $start = 0;
        while ($len > 0) {
            $re = read(STDIN, $post_data, $len, $start);
            last if (!$re);
            $start += $re;
            $len -= $re;
        }
    }
    if ($renv->{rashttp_log}) {
      open(W, ">>/opt/SUNWstade/log/rashttp.log");
      print W Util->get_today() . " " . $address . "\n";
      close(W);
    }
    ($address, $variables) = split(/\?/, $address, 2);

    my $Q_LIST = &make_list($variables);
    foreach $variables (@$Q_LIST) {
      $OUT = ""; %Q = (); $q = {};
      my(%q2);
      &parse($variables, \%Q, 0);
      my %cks = &parse_cookies($http_cookie); 
      foreach my $el (keys %cks) {
        $Q{"COOKIE_$el"} = $cks{$el};
      }
      if ($method =~ /POST/) {
         &parse($post_data, \%q2, 0);
         foreach my $x (keys %q2) {
           $Q{$x} = $q2{$x};  # overlay the post over the url
         }
      }
      $Q{GO} = "idx" if (!$Q{GO});
      $q = \%Q;
      my($done, $fun) = $http->process_url($q, $master, $httprawu, $address);
      print $OUT if ($OUT);  # browser login
      $HTTPQ=$q;
      eval {
        if ($fun) {
           if ($master && !$q->{GET} && !$q->{PUT} && ($q->{GO} !~ /\:\:/) ) {
             print Html->text_header();
             print "<body bgcolor=#F0F0F0>\n\n<center><h3>This is a SLAVE ";
           } else {
             Http->runFunction($fun, $q, $post_data, $util);
           }
        }
      };
      if ($@) {
         print Html->body();
         print "Execution error: $@<br>\n";
      }
    }
    #FCGI::Flush();
    exit if ( (time - $fcgi_start)  > 60*60);
  }
}

sub make_list {
  my($variables) = @_;
  my(@Q_LIST, $x);
  if (index($variables, "&GO2=") > 0) {
     my($x);
     @Q_LIST = split(/\&GO\d=/, $variables);
     for ($x = 1; $x <= $#Q_LIST; $x++) {
        my $el = $Q_LIST[$x];
        $Q_LIST[$x] = "GO=" . $Q_LIST[$x];
     }
  } else {
     push(@Q_LIST, $variables);
  }
  return \@Q_LIST;
}




sub this_is_a_slave {
  my($master, $hh) = @_;
  require Labels;
  my $LB = Labels->read();
  my $text = $LB->expand(go_to_master => "<a href=$hh://$master:$main::RASPORT target=_top>");

  print "<body bgcolor=#F0F0F0>$text";
}

#########################
#  UNIX-LOOP
#########################

sub unix_loop {
  my($http, $util, $master) = @_;
  my($client) = 0;
  my $starttime = time;
  my($fun, $q, $post_data, $ix2);
  #debug("timeout = $http->{timeout}");

  local $SIG{ALRM} = sub { 
        unlink $UNIXFILE; 
        close(Server);  
        unlink($PID); 
        &close_sessions();
        #debug("erasing $PID");
        exit(0);
       };

  while (1) {
    my $paddr = accept(Client, Server);
    alarm(0);
    select(Client); $| = 1;
    #$client->autoflush(1);
    #select($client);

    local($SIG{'ALRM'}) = \&bye;
 #  $SIG{'__DIE__'} = \&dead;
    
    $address = 0; 
    alarm 60;
    $SAVE = "";
    &http_init;
    while ($line = <Client>) {
        process1($line);
    }
    if ($method =~ /POST/) {  # get POST data
         $len = $httpcl; $start = 0;
         while ($len > 0) {
             $re = read(Client, $post_data, $len, $start);
             last if (!$re);
             $start += $re;
             $len -= $re;
         }
    }
    # check address1
    if (!$address || (0+$httpver > 1 && !$httphost)) {
        &ht_response(400, "Bad Request");
        &hterror("Bad Request", "The server cannot understand your request.");
        next;
    } 
    ($address, $variables) = split(/\?/, $address, 2);

    my $Q_LIST = &make_list($variables);

    foreach $variables (@$Q_LIST) {
      ($fun, $q) = &process2($http, $post_data, $master);
      print $OUT if ($OUT);
      $HTTPQ=$q;
      eval {
        if ($fun) {
           if ($master && !$q->{GET} && !$q->{PUT} &&   ($q->{GO} !~ /\:\:/) ) {
             print Html->text_header();
             my $hh = $main'RASPORT =~ /443/ ? "https":"http";
             &this_is_a_slave($master, $hh);
           } else {
             Http->runFunction($fun, $q, $post_data, $util);
           }
        }
      };
      if ($@) {
         print "Execution error: $@<br>\n";
      }
    }

    close(Client);
    last if (time - $starttime > 60 * 10);  # if alarm does not work
    alarm($http->{timeout});
  }
  close(Client);
  close(Server);
  &close_sessions();

  unlink $UNIXFILE;
}
  


sub stdin_process {
   my($http) = @_;
   my($post_data, $q, $fun);

   $SIG{'ALRM'} = \&bye;
#  $SIG{'__DIE__'} = \&dead;
   
   # $sock = getpeername(STDIN);
   
   select(STDOUT); $|=1; $address = 0; 
   alarm 60;
   $SAVE = "";
   &http_init;
   while ($line = <STDIN>) {
       process1($line);
   }
   if ($method =~ /POST/) {  # get POST data
        $len = $httpcl; $start = 0;
         while ($len > 0) {
            $re = read(STDIN, $post_data, $len, $start);
            last if (!$re);
            $start += $re;
            $len -= $re;
        }
   }
   if (!$address || (0+$httpver > 1 && !$httphost)) {
       &ht_response(400, "Bad Request");
       &hterror("Bad Request", "The server cannot understand your request.");
       return ();
   }

   ($address, $variables) = split(/\?/, $address);
   ($fun, $q) = &process2($http, $post_data);
   print $OUT if ($OUT);
   return ($fun, $q, $post_data);  
}

#  $fun =  loadPackage("get_", $q{GET});

sub loadPackage {
  my($prefix, $fun) = @_;
  my( $pk, $name, $pk0);
  my($i) = rindex($fun, "::");
  my($i2) = rindex($fun, "->");
  my $sym;
  if ($i > 0 || $i2 > 0) {
    if ($i2 > 0) {
      $pk = substr($fun, 0, $i2);
      $name = substr($fun, $i2+2);
      $sym = "->";
    } else {
      $pk = substr($fun, 0, $i);
      $sym = "::";
      $name = substr($fun, $i+2);
    }
    $pk0 = $pk;
    $pk0 =~ s/\:\:/\//g;
    eval {
       require "$pk0.pm";
    };

    if ($@) {
      &log1("Error on $pk0: $@");
      print Html->text_header();
      print "<body bgcolor=#F0F0F0><b>WebServer cannot load $pk0:</b><br> $@<br>";
      return undef;
    } 
    return "$pk$sym$prefix$name";

  } else {
    return $prefix . $fun;
  }
}
  

sub process1 {
   my($line) = @_;

   $SAVE .= $line;
#  &debug0($line);
   if($line =~ /^([A-Z]+)\s+([^\s]+)\s+([^\s\r\l\n]*)/) {  # GET / POST
        $method = $1;
        $address = $2; 
        $httpver = $3;
        $httpref = '';
        $httpua = '';
        $httpver = ($httpver =~ m#HTTP/([0-9]\.[0-9]+)#) ?  ($1) : "1.0";
        $address =~ s#^http://[^/]+/#/#;

    } else {                                      # ARGS
         $line =~ s/[\r\l\n\s]+$//;
         if ( $line =~ /^Host: (.+)/i) {
            $httphost = $1; $httphost =~ s/:\d+$// ;
         }
         if ($line =~ /^Referer: (.+)/i) { 
            $httpref = $1;
         }
         ($line =~ /^User-agent: (.+)/i) && ($httpua = $1);
         ($line =~ /^Content-length: (\d+)/i) && ($ENV{'CONTENT_LENGTH'} = $httpcl = $1);
         ($line =~ /^Content-type: (.+)/i) && ($ENV{'CONTENT_TYPE'} = $httpct = $1);
         ($line =~ /^Accept-Language: (.+)/i) && ($ENV{'HTTP_ACCEPT_LANGUAGE'} = $http_lang = $1);
         ($line =~ /^REMOTE_USER: (.+)/i) && ($ENV{'REMOTE_USER'} = $http_remuser = $1);
         ($line =~ /^Host: (.+)/i) && ($ENV{'LOCAL_HOST'} = $1);
         ($line =~ /^HTTPS: (.+)/i) && ($ENV{HTTPS} = $http_ssl = $1);
         ($line =~ /^Expect: /) && ($expect = 1);
         ($line =~ /^Authorization: Basic (.+)/i) && ($httprawu = $1);
         ($line =~ /^Cookie: (.+)/i) && ($http_cookie = $1);

         last if ($line =~ /^$/);  # empty line is delimiter
    }
}


sub process2 {
   my($http, $post_data, $master) = @_;
   if ($expect) {
       &ht_response(417, "Expectation Failed");
       &hterror("Expectation Failed", "The server does not support this method.");
       &log; 
       return (undef);
   }

   if ($method !~ /^(GET|HEAD|POST)$/) {
      &ht_response(501, "Illegal Method");
      &hterror("Illegal Method", "Only GET, HEAD and POST are supported.");
      &log; return (undef);
   }
   my(%q, %q2);
   $variables = Html->unscramble($variables) if (substr($variables,0,4) eq "SGO=");
   &parse($variables, \%q, 0);

   my %cks = &parse_cookies($http_cookie); 
   foreach my $el (keys %cks) {
      $q{"COOKIE_$el"} = $cks{$el};
   }

   if ($method =~ /POST/) {
      &parse($post_data, \%q2, 0);
      foreach my $x (keys %q2) {
         $q{$x} = $q2{$x};  # overlay the post over the url
      }
   }
#  foreach my $x (keys %q) {print "$x=$q{$x}<br>"}

   my($ctype) = "Content-type: text/html\n\n\n";
   $address=~ s#^/?#/#;
   1 while $address =~ s#/\.(/|$)#$1#;
   1 while $address =~ s#/[^/]*/\.\.(/|$)#$1#;
   1 while $address =~ s#^/\.\.(/|$)#$1#;
   
   my($done,$fun) = $http->process_url(\%q, $master, $httprawu, $address );
   return ($fun, \%q) if ($done);

   if(!open(S, $raddress)) {  # static file
        &hterror404; 
        return (undef);
   } else {
       if (-x $raddress) {      # no CGI supported
         &hterror404; 
         return (undef);
       }
       ($x,$x,$x,$x,$x,$x,$x,$length,$x,$mtime) = stat(S);
       $mtime = scalar gmtime $mtime;
       ($dow, $mon, $dt, $tm, $yr) = ($mtime =~ m/(...) (...) (..) (..:..:..) (....)/);
       $dt += 0; $yr += 0;
       $ctype = 0;
       foreach $el (keys %content_types) {
           if ($raddress =~ /\.$el$/i) {
               $ctype = $content_types{$el};
           }
       }
       $ctype ||= 'text/plain';
       &ht_response(200, "OK");
       &hthead("Last-Modified: $dow, $dt $mon $yr $tm GMT");
       &htcontent("", $ctype, $length);
       unless ($method eq 'HEAD') {
          while(!eof(S)) {
              read(S, $q, 16384);
              $OUT .= $q;
          }
       }
       alarm 0;
       return (undef);
   }
   $http->log;
}

sub log1 {
  my($l) = @_;
  open(O4, ">>/opt/SUNWstade/log/rashttp.log"); 
  my $to = Util->get_today();
  print O4 "$to $l\n"; 
  close(O4);
}

sub process_url {
  my($http, $q, $master, $httprawu, $address) = @_;

  my $html_login = $http->{html_login};

  #foreach my $e (sort keys %ENV) { &log1("$e=$ENV{$e}") }

# foreach my $e (keys %$q) {$oo .= "$e=$q->{$e}\n"}

   if ($q->{RESETLOGIN} && !$q->{ACTION}) {
      if ($html_login) {
          $q->{_INFO_} = "LOGOUT";
          Html->save_header("Set-Cookie: LID=X; path=/;\n");
          return(1, loadPackage("", $html_login));
      }
      my $cnt = (index($httpua, "Netscape/7.") >= 0) ? 2 : 1;
      if ($COUNT{$http_remuser} < $cnt) {
        print &reset_login(); 
        $COUNT{$http_remuser}++;
        return (1);
      } else {
        $q->{GO} = "GUI::Navigation::index"; 
      }
   }
   $ruser = {};

   if (!$q->{GET} && !$q->{PUT} && !$master && !$CGI) { # no need to login to slave
       my $fail = 1;
       $httpuser = '';
       # cookie and LID are set when the login is done using the url

       my $LID = $httprawu || $q->{COOKIE_LID} || $q->{LID};  # LID=LOGIN_ID
       $oo = "";
       if ($q->{ACTION_LOGIN} && $q->{LOGIN_login}) {
          $LID = MIME::Base64::encode("$q->{LOGIN_login}:$q->{LOGIN_password}"); chomp($LID);
          $q->{LID} = $LID;
       }
       if ($LID) {
         $LID =~ tr#A-Za-z0-9+/##cd;
         $LID =~ tr#A-Za-z0-9+/# -_#;
         $LID = unpack("u", pack("c", 32+0.75*length($LID)) . $LID);
         ($httpuser, $httppw) = split(/:/, $LID);
       }
       #foreach my $e (keys %ENV) {$xx .= "$e=$ENV{$e}\n"}
       #log1("user=$httpuser , login=$http->{login} , $httppw, pass=$http->{password}, $http_lang,  $xx");
       $fail = Http->validate($httpuser, $httppw, $q);
       $fail = Http->session($fail, $q) if (!$httprawu); # no session on basic-auth.

       if ($fail) {
          if ($html_login) {
            $q->{ERR} = 1 if ($q->{ACTION});
            my $save;
            return(1, loadPackage("", $html_login));
          } else {       
            $httpuser = '';
            if ($ENV{FCGI}) {
              &hthead("Status: 401 Unauthorized");
            } else {
              &ht_response(401, "UNAUTHORIZED");
            }
            &hthead("WWW-Authenticate: Basic realm=\"User\"");
            &hterror("Authorization Required", $INVALID_LOGIN);
            &log; 
            return (1, undef);
          }
       } elsif ($html_login) {
          if ($q->{ACTION_LOGIN}) {
            delete $q->{GO};
          }
          $q->{GO} = "idx" if (!$q->{GO});
       }
    }
    $COUNT{$http_remuser} = 0;
#   foreach my $e (keys %$q) {$oo .= "$e=$q->{$e},"}
   
    $address =~ s/%([0-9a-fA-F]{2})/pack("H2", $1)/eg;
    $raddress = "$http->{root}$address" ;
    if ($address !~ m#/$# && -d $raddress) {
       &hterror301("http://NSAgent$address/");
    }
    if ($ruser->{language} || $q->{LID}) {
      my $http_header;
      $http_header .= "Set-Cookie: RAS_LANG=$ruser->{language}; path=/;\n" if ($ruser->{language});
      if ($q->{LID}) {
          $http_header .= "Set-Cookie: LID=$q->{LID}; path=/;\n";
      }
      my ($err1, $h1) = &run_url($q);
      $http_header .= $h1;
      Html->save_header($http_header); # insert in header on the next Html->body()
    }

    alarm 0;
    my($fun);
#   log1("fun2=$fun, $q->{GO}, $raddress, $http->{root}");
    if ($q->{GET}) {
       $fun =  loadPackage("get_", $q->{GET});

    } elsif ($q->{PUT}) {
       $fun =  loadPackage("put_", $q->{PUT});

    } elsif ($q->{GO}) {
       $fun =  loadPackage("", $q->{GO});
       return(1, undef) if (!$fun);

    } elsif ($raddress eq $http->{root} || $raddress eq "$http->{root}/" ) {
       $q->{GO} = "idx";
       $fun =  loadPackage("", $q->{GO});
       return(1, undef) if (!$fun);
    }
    if ($fun) {  # functions
       return (1, $fun);
    }
    return (0);
}


sub time2isoz {
  my ($time) = @_;

  my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
    sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
            $year+1900, $mon+1, $mday, $hour, $min, $sec);
}



sub run_url {
  my($q) = @_;
  return undef if (!$q->{RUN_URL});
  if ($q->{LOGIN_storade_only}) {
     return (undef, "Set-Cookie: JSESSIONID=; path=/se6000ui;\nSet-Cookie: JSESSIONID=; path=/;\n");
  }
  require Util::Http;
  my $url = "http://localhost$q->{RUN_URL}";
  my $login = $q->{LOGIN_login};
  my $pass  = $q->{LOGIN_password};
  $url =~ s/\$u/$login/;
  $url =~ s/\$p/$pass/;

  my($err, $str, $res) = Util::Http->get($url, 10);
  my $cook = $res->header('set-cookie');
  my $rc;
  if ($cook) {
    my $ix = index($cook, ";");
    $cook = substr($cook,0,$ix);
    $rc  = "Set-Cookie: $cook; path=/se6000ui;\n";
    $rc .= "Set-Cookie: $cook; path=/;\n";
  }
  return (undef, $rc);


  # NOT USED
  my $o =<<EOF;
 <script>
  function  run_url(a) {
   var O = window.open('$url','run_url','menubar=no,resizable=yes,scrollbars=no,width=300,height=60');
   }
  run_url(0);
  </script>
EOF
}



sub session { 
  my($class, $fail, $q) = @_;
  return $fail if ($fail);
  my $renv       = System->get_renv();
  my $session_to = $renv->{session_timeout};

  if ($session_to && $renv->{html_login} ) {
    my $ruser      = System->get_ruser();
    my $rem        = $ENV{REMOTE_USER} || $ruser->{userid};

    if ($q->{ACTION_LOGIN} || !exists $SESSIONS->{$rem}) {  # good login
       $SESSIONS->{$rem} = { time => time };
       return 0;
    }
    if (exists $SESSIONS->{$rem} ) {              # already login
       if ((time - $SESSIONS->{$rem}{time}) > $session_to) {
          $q->{_INFO_} = "TIMEOUT";
          return 1;                               # time-out
       } else {
          $SESSIONS->{$rem}{time} = time;         # move timeout
       }
    }
  }
  return $fail;
}
  

#  $fail = &validate();

# "Validate /rashttp"
sub validate {
  my($class, $login_name, $login_pass, $q) = @_;
  my $renv      = System->get_renv();
  my $http      = $CURRENT_HTTP;
  my $http_lang = $ENV{HTTP_ACCEPT_LANGUAGE};
  if ($http_lang) {
    if (substr(lc($http_lang),0,5) eq "zh-tw") {
       $http_lang = "zt";
    } else {
       $http_lang = substr($http_lang,0,2);
     }
  }

  return 1 if (!$login_pass);

  my $fail = 1;

  # ROOT sa_admin role
  if ($login_name eq "sa_admin") { # ROOT sa_admin role
	 my @sa_admin = getpwnam($login_name);
    my $sa_pass = $sa_admin[1];
	 if ($sa_pass && crypt($login_pass, substr($sa_pass, 0, 2)) eq $sa_pass){
       my $l1;
       if ($renv->{ras_language}) {
          $l1 = $renv->{ras_language} eq "b" ? $http_lang : $renv->{ras_language};
       } elsif ($http_lang) {
          $l1 = $http_lang;
       }
       $ruser = {  userid   => "ROOT",
                   language => $l1,
                   window   => $renv->{window},
                   access   => $renv->{accessible},
              } ;  # set_ras_user
       System->set_ruser($ruser);
       return 0;
     }
     return 1;
  }

  # STORADE LOGINS / ROLES
  if ($http->{roles} && exists $http->{roles}{$login_name} ) { 
    my $r = $http->{roles};
    if ($r->{$login_name}{nis} eq "Y") {
       my @nis = getpwnam($login_name);
       my $nis_pass = $nis[1];

       if ($nis_pass && crypt($login_pass, substr($nis_pass, 0, 2)) eq $nis_pass) {
         if ($http_lang && 
            ($r->{$login_name}{browser} eq "B" || $r->{$login_name}{language} eq "B")) {
           $r->{$login_name}{browser}  = "B";
           $r->{$login_name}{language} = $http_lang;
	 }

         $ruser =  $r->{$login_name};
         System->set_ruser($ruser);

         return 0;
       }

    } else {
      if ($login_name && $r->{$login_name}{password} && 
         crypt($login_pass, substr($r->{$login_name}{password},0,2)) eq $r->{$login_name}{password}) {

         if ($http_lang && 
            ($r->{$login_name}{browser} eq "B" || $r->{$login_name}{language} eq "B")) {
           $r->{$login_name}{browser}  = "B";
           $r->{$login_name}{language} = $http_lang;
	 }
         $ruser =  $r->{$login_name};
         System->set_ruser($ruser);
         return 0;
      }
    }
  }
  # NIS

  if ($fail && $renv->{nis_login} ) {
    my @nis = getpwnam($login_name);
    my $nis_pass = $nis[1];
    if ($nis_pass && crypt($login_pass, substr($nis_pass, 0, 2)) eq $nis_pass) {
      my $l1;
      if ($http_lang) {
         $l1 = $http_lang;
      }
      $ruser = {  userid => $login_name,
                language => $l1,
                  window => $renv->{window},
                  access => $renv->{accessible},
                   roles => "guest",
              } ;  # set_ras_user
      System->set_ruser($ruser);

      return 0;
    }
  }
  return 1;
}

sub hterror {
    local($errstr, $expl) = (@_);
    my $renv = System->get_renv();
    &htcontent(<<"EOF", "text/html");
<html>
<body bgcolor=#F0F0F0>
&nbsp;<br>
<h1>$errstr</h1>
$expl
<hr>
<address>$renv->{GSV_ACRONYM} / $renv->{version}</address>
</body>
</html>
EOF
}

sub hterror404 {
    &ht_response(404, "File Not Found");
    &hterror("File Not Found",
        "The resource $address was not found on this system.");
}

sub hterror301 {
    &ht_response(301, "Moved Permanently");
    &hthead("Location: @_");
    &hterror("Resource Moved Permanently",
        "This resource has moved <a href = \"@_\">here</a>.");
    $keep = 0; 
  &log;
}

sub parse {
  my($query_s, $q, $flag) = @_;  # 1 = do not concatenate
  my($cnt);
  
   foreach $el (split(/&/,$query_s)) {
     my($NAME,$VALUE) = split(/=/, $el);
     $NAME =~ s/\+/ /g;
     $NAME =~ s/%([0-9\.|A-F|a-f]{2})/pack(C,hex($1))/eg;

     $VALUE =~ s/\+/ /g;
     $VALUE =~ s/%([0-9|A-F|a-f]{2})/pack(C,hex($1))/eg;
     if ($q->{$NAME} && !$flag) {
        $q->{$NAME} .= "\t$VALUE";
     } else {
        $q->{$NAME} = $VALUE;
     }

  }
  return %q;
}

sub read_cgi {
  my($class) = @_;
  my(%q);
  my($agent, $req, $length, $type, $error, $file_name, $file_content, $bound);
  my($query_s, $l);

  $agent =  $ENV{HTTP_USER_AGENT};
  $req   =  $ENV{REQUEST_METHOD};
  $length=  $ENV{CONTENT_LENGTH};
  $type  =  $ENV{CONTENT_TYPE};
  $error =  0;
  if ($req eq "GET") {
      $query_s = $ENV{QUERY_STRING};
      &parse($query_s, \%q, 0);

  } elsif ($req eq "POST") {
       if ($length =~ /[0-9]+/) {
              $l= read(STDIN, $query_s, $length);
              &parse($query_s, \%q, 0);
        } else {
              $error = 1;
        }
  } else {
     $error = 1;
  }
  return ($error, \%q, $query_s);
}

sub parse_cookies {
  my($query_s) = @_;
  my(%cks);

  foreach (split(/; */,$query_s)) {
     ($NAME,$VALUE) = split(/=/, $_);
     $cks{$NAME} = $VALUE;
  }
  return %cks;
}





1;
