Added support for CGI handling, still remain some problems for headers,

[helm.git] / helm / http_getter / http_getter.pl.in
diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in

index 484041c8e7d853e66caad2ad4bf098bd85767a23..e301963bcf65af3225a866a54c5a82306fc4cfdd 100755 (executable)
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -29,6 +29,7 @@ my $VERSION = "@VERSION@";
  
  # various variables
  my ($HELM_LIB_PATH);
+my $cgi_dir = "@HELM_CGI_DIR@";
  my (%map);
  
  # First of all, let's load HELM configuration
@@ -224,7 +225,7 @@ while (my $c = $d->accept) {
             mk_urls_of_uris();
             kill(USR1,getppid()); # signal changes to parent
             print " done\n";
-           answer($c,"<html><body><h1>Update done</h1></body></html>","text/html","");
+           html_nice_answer($c,"Update done");
          } elsif ($http_method eq 'GET' and $http_path eq "/ls") {
              # send back keys that begin with a given uri
             my ($uritype,$uripattern,$uriprefix);
@@ -243,8 +244,8 @@ while (my $c = $d->accept) {
             if ($uritype ne "invalid") { # uri is valid
              if (($outype ne 'txt') and ($outype ne 'xml')) { # invalid out type
               print "Invalid output type specified: $outype\n";
-             answer($c,"<html><body><h1>Invalid output type, may be ".
-              "\"txt\" or \"xml\"</h1></body></html>","text/html","");
+             html_nice_answer($c,"Invalid output type, must be ".
+              "'txt' or 'xml'");
              } else { # valid output
               print "BASEURI $baseuri, FORMAT $outype\n";
               $cont = finduris($uritype,$uripattern,$outype);
@@ -259,13 +260,33 @@ while (my $c = $d->accept) {
             } else { # invalid uri
              print "Invalid uri: $baseuri, may begin with 'cic:', ".
               "'theory:' or '*:'\n";
-            answer($c,"<html><body><h1>Invalid uri , may begin with ".
-             "\"cic:\", \"theory:\" or \"*:\"</h1></body></html>","text/html","");
+            html_nice_answer($c,"Invalid uri , must begin with ".
+             "'cic:' or 'theory:'");
             }
          } elsif ($http_method eq 'GET' and $http_path eq "/help") {
-           print "Help requested!";
-           answer($c,"<html><body><h1>HTTP Getter Version ".
-            $VERSION."</h1></body></html>","text/html","");
+           print "Help requested!\n";
+           html_nice_answer($c,"HTTP Getter Version: $VERSION");
+        } elsif ($http_method eq 'GET' and $http_path =~ /\.cgi$/) {
+           print "CGI requested!\n";
+           if ($http_path !~ /^\/[^\/]*\.cgi$/) {
+            html_nice_answer($c,"Invalid CGI name: $http_path, ".
+            "you can't request CGI that contain a slash in the name\n");
+           } elsif (stat "$cgi_dir"."$http_path") {
+            if (not -x "$cgi_dir/$http_path") {
+             html_nice_answer($c,"CGI $http_path found but not ".
+              "executable\n");
+            } else { # exec CGI and anser back its output
+             my %old_ENV = %ENV;
+             %ENV = ();
+             $ENV{'QUERY_STRING'} = $http_query;
+             my $cgi_output = `$cgi_dir/$http_path`;
+             answer($c,$cgi_output,"","");
+             %ENV = %old_ENV;
+            }
+           } else {
+            html_nice_answer($c,"CGI '$http_path' not found ".
+             "in CGI dir '$cgi_dir'");
+           }
          } else {
              print "\n";
              print "INVALID REQUEST!!!!!\n";
@@ -562,15 +583,25 @@ sub download {
  }
  
  sub answer {
+# answer the client setting content, Content-Type and Content-Enconding
+# of the answer
   my ($c,$cont,$contype,$contenc) = @_;
   my $res = new HTTP::Response;
   $res->content($cont);
- $res->push_header("Content-Type" => $contype);
+ $res->push_header("Content-Type" => $contype)
+   unless ($contype eq "");
   $res->push_header("Content-Encoding" => $contenc)
     unless ($contenc eq "");
   $c->send_response($res);
  }
  
+sub html_nice_answer {
+# answer the client whith a nice html document
+ my ($c,$content) = @_;
+ $content = "<html><body><h1>$content</h1></body></html>";
+ answer($c,$content,"text/html","");
+}
+
  sub helm_wget {
  #retrieve a file from an url and write it to a temp dir
  #used for retrieve resource index from servers