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

#use IO::Socket;
use Socket;
use Html;

#  $Id: Http.pm,v 1.41 2002/10/31 17:33:29 ccadieux Exp $
#
# $h = Http->new({ log => 0 });
#

$PID;
$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";

$RESETLOGIN =<<EOF;
HTTP/1.0 401 Authorization Required
Server: rashttp/1.1
MIME-Version: 1.0
Version: 1.0
Date: Sun, 30 Sep 2001 18:09:10 GMT
WWW-Authenticate: Basic realm=\"User\"
Content-Type: text/html

<h2>Authorization Required
EOF

%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, 
#
sub cgi {
  my($http) = @_;
  my(%q);
  my $s = $ENV{GET};
  $httpver = "1.0";
  my $ix = index($s, "?");
  my $master = Util->findMaster();

  if ($ix > 0) {
    &parse(substr($s,$ix+1), \%q, 0);
    my($done,$fun) = $http->process_url(\%q, $master, $ENV{PASSWD}, $s);
    print $OUT if ($OUT);
    if ($fun) {
      if (defined(&$fun)) {
        #print $http->text_header;
        &$fun(\%q);
      } else {
        $http->error(501, "Illegal Method", "function '$fun' not found");
      }
    }
  }
}
     

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

  bless($info, "Http");
  return $info;
} 

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 text_header {
  my($http,$text) = @_;
  $Html::HEADER_DONE = 1;
  "HTTP/1.0 200 OK\nContent-type: text/html\n$text\n\n";
}

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 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_remuser = $http_lang = $http_ssl = undef;
  $post_data = undef;
  $Html::HEADER_DONE = 0;
}

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";
  mkdir $D, 0755 if (!-d $D);
  opendir(O2, $D);
  my @DIRS = readdir(O2); 
  closedir(O2);
  foreach my $d (@DIRS) {
      next if ($d !~ /^$name\.(\d+)/);
      $pid = $1;
      unlink "$D/$d";
      kill 9, $pid;
      debug("rashttp already running, killing $pid: $!");
  }
  $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 "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 "Function '$fun' not found!<br>";
     }
   }
}

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); 
        exit(0);
       };

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

    ($fun, $q, $post_data) = Http::sock_process($http, $client, $master);
    $HTTPQ=$q;

    eval {
      if ($fun) {
         #print $http->text_header;
         if ($master && !$q->{GET} && !$q->{PUT} &&   ($q->{GO} !~ /\:\:/) ) {
           print 
             "<body bgcolor=#F0F0F0>\n\n<center><h3>This is a SLAVE Storage Agent, connect to the MASTER ".
             "with your browser<p> Go  to ".
             "<a href=http://$master:$main'RASPORT target=_top>MASTER Host Agent</a> now.\n";
         } 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);

  unlink $UNIXFILE;
}
  

sub sock_process {
   my($http, $sock, $master)  = @_;
   my($post_data, $q, $fun);
   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;
        }
   }
   ($fun, $q) = &process2($http, $post_data, $master);
   print $OUT if ($OUT);
   return ($fun, $q, $post_data);  
}


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;
        }
   }
   ($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 ($@) {
      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;
   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://[^/]+/#/#;
        next unless ($httpver < 1);
    } 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{'ACCEPT_LANGUAGE'} = $http_lang = $1);
         ($line =~ /^REMOTE_USER: (.+)/i) && ($ENV{'REMOTE_USER'} = $http_remuser = $1);
         ($line =~ /^HTTPS: (.+)/i) && ($ENV{HTTPS} = $http_ssl = $1);
         ($line =~ /^Expect: /) && ($expect = 1);
         ($line =~ /^Authorization: Basic (.+)/i) && ($httprawu = $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 (!$address || (0+$httpver > 1 && !$httphost)) {
       &ht_response(400, "Bad Request");
       &hterror("Bad Request", "The server cannot understand your request.");
       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);
   }
   ($address, $variables) = split(/\?/, $address);
   my(%q, %q2);
   $variables = Html->unscramble($variables) if (substr($variables,0,4) eq "SGO=");
   &parse($variables, \%q, 0);

   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, ">>/tmp/rashttp_log"); print O4 "$l\n"; close(O4);
}

sub process_url {
  my($http, $q, $master, $httprawu, $address) = @_;
  my $renv = System->get_renv();

   if ($q->{RESETLOGIN}) {
      my $cnt = index($httpua, "Netscape/7.") >= 0 ? 2 : 1;
      if ($COUNT{$http_remuser} < $cnt) {
        print $RESETLOGIN;
        $COUNT{$http_remuser}++;
        return (0);
      } else {
        $q->{GO} = "GUI::Navigation::index";
      }
   }
   if (!$q->{GET} && !$q->{PUT} && !$master) { # no need to login to slave
       $httprawu =~ tr#A-Za-z0-9+/##cd;
       $httprawu =~ tr#A-Za-z0-9+/# -_#;
       $httprawu = unpack("u", pack("c", 32+0.75*length($httprawu)) . $httprawu);
       ($httpuser, $httppw) = split(/:/, $httprawu);
       my $fail = 1;

#      log1("user=$httpuser , login=$http->{login} , $httppw, pass=$http->{password}, $http_lang");
       if ($httpuser eq $http->{login} && 
         crypt($httppw, substr($http->{password}, 0, 2)) eq $http->{password}) {
         my $l1;
         if ($http_lang) {
            if (substr($http_lang,0,2) eq "fr") {
               $l1 = "fr";
            } elsif (substr($http_lang,0,2) eq "ja") {
               $l1 = "ja";
            }
         }
         System->set_ruser( {  userid => "ROOT", 
                             language => $l1, 
                               window => $renv->{window}, 
                               access => $renv->{accessible},
                            }) ;  # set_ras_user
                
         $fail = 0;
       } elsif ($http->{roles}) {
         my $r = $http->{roles};
         if ($httpuser &&  $r->{$httpuser}{password} && 
             crypt($httppw, substr($r->{$httpuser}{password},0,2)) eq $r->{$httpuser}{password}) {
            if ($http_lang && $r->{$httpuser}{language} eq "B") {
              if (substr($http_lang,0,2) eq "fr") {
                 $r->{$httpuser}{language} = "fr";
              } elsif (substr($http_lang,0,2) eq "ja") {
                 $r->{$httpuser}{language} = "ja";
              }
            }
            System->set_ruser( $r->{$httpuser});
            $fail=0;
         }
       }
       if ($fail) {
          $httpuser = '';
          &ht_response(401, "Authorization Required");
          &hthead("WWW-Authenticate: Basic realm=\"User\"");
          &hterror("Authorization Required", $INVALID_LOGIN);
          &log; 
          return (1, undef);
       }
    }
    $COUNT{$http_remuser} = 0;
    $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 (-d $raddress) {
       $raddress = "${raddress}index.html";
    }
    alarm 0;
    my($fun);

    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);
    } else {
       $fun = $q->{GO};
    }
    if ($fun) {  # functions
       return (1, $fun);
    }
    return (0);
}

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)) {
     ($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);
}




1;
