X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter.pl.in;h=e301963bcf65af3225a866a54c5a82306fc4cfdd;hb=fb158d51c621e55962a6139d03cd1678cfb2e8f1;hp=44001955c7570652434640874f17bc1fd6ddefec;hpb=e86b64b7b0af05d1c29b1fedadf69aaf5cb10a30;p=helm.git

diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 44001955c..e301963bc 100755
--- 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
@@ -106,23 +107,31 @@ while (my $c = $d->accept) {
 
 	print "\nUnescaped query: ".$http_query."\n";
 
-        if ($http_method eq 'GET' and $http_path eq "/getciconly") {
+        if ($http_method eq 'GET' and $http_path eq "/getxml") {
             # finds the uri, url and filename
             my $cicuri = $inputuri;
             my $answerformat = $cgi->param('format');
+            my $patch_dtd = $cgi->param('patch_dtd');
             $answerformat = "" if (not defined($answerformat));
-
+            $patch_dtd = "" if (not defined($patch_dtd));
             if (($answerformat ne "gz") and ($answerformat ne "normal")
                and ($answerformat ne "")) {
              die "Wrong output format: $answerformat, must be 'normal' ".
                  "or 'gz'\n";
             }
+            if (($patch_dtd ne "yes") and ($patch_dtd ne "no")
+               and ($patch_dtd ne "")) {
+             die "Wrong param, patch_dtd must be 'yes' or 'no'\n";
+            }
 
             my $cicfilename = $cicuri;
             $cicfilename =~ s/cic:(.*)/$1/;
             $cicfilename =~ s/theory:(.*)/$1/;
 
             my $cicurl   = $map{$cicuri};
+            if (not defined($cicurl)) {
+             die "uri \"$cicuri\" can't be resolved\n";
+            }
             my $extension;
             if ($cicurl =~ /\.xml$/) { # non gzipped file
               $extension = ".xml";
@@ -141,11 +150,21 @@ while (my $c = $d->accept) {
                print_request("cic",$cicuri,$cicurl,$cicfilename);
 
                # Retrieves the file
-               my $ciccontent = download(0,"cic",$cicurl,$cicfilename,$answerformat);
+               my $ciccontent = download($patch_dtd,"cic",$cicurl,$cicfilename,$answerformat);
 
                # Answering the client
-               answer($c,$ciccontent);
+                answer($c,$ciccontent,"text/xml","x-gzip");
             }
+        } elsif ($http_method eq 'GET' and $http_path eq "/resolve") {
+          my $outputurl = $map{$inputuri};
+          $outputurl = "" if (not defined($outputurl));
+          $cont = "<?xml version=\"1.0\" ?>\n\n";
+          if ($outputurl eq "") {
+           $cont .= "<unresolved />\n";
+          } else {
+           $cont .= "<url value=\"$outputurl\" />\n";
+          }
+          answer($c,$cont,"text/xml","");
         } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
             my $filename = $inputuri;
             $filename = $dtd_dir."/".$filename;
@@ -161,7 +180,7 @@ while (my $c = $d->accept) {
 	        $cont .= $_;
 	       }
                close(FD);
-               answer($c,$cont);
+               answer($c,$cont,"text/xml","");
             } else {
                die "Could not find DTD!";
             }
@@ -176,7 +195,7 @@ while (my $c = $d->accept) {
 	        $cont .= $_;
 	       }
                close(FD);
-               answer($c,$cont);
+               answer($c,$cont,"text/plain","");
             } else {
                die "Could not find Style Configuration File!";
             }
@@ -196,27 +215,17 @@ while (my $c = $d->accept) {
                 $cont .= $_;
                }
                close(FD);
-               answer($c,$cont);
+               answer($c,$cont,"text/xml","");
             } else {
                die "Could not find XSLT!";
             }
-        } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
-            my $quoted_html_link = $html_link;
-            $quoted_html_link =~ s/&/&amp;/g;
-            $quoted_html_link =~ s/</&lt;/g;
-            $quoted_html_link =~ s/>/&gt;/g;
-            $quoted_html_link =~ s/'/&apos;/g;
-            $quoted_html_link =~ s/"/&quot;/g;
-            print "\nConfiguration requested, returned #$quoted_html_link#\n";
-	    $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
-            answer($c,$cont);
         } elsif ($http_method eq 'GET' and $http_path eq "/update") {
             # rebuild urls_of_uris.db
            print "Update requested...\n";
            mk_urls_of_uris();
            kill(USR1,getppid()); # signal changes to parent
            print " done\n";
-           answer($c,"<html><body><h1>Update done</h1></body></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);
@@ -235,23 +244,49 @@ 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>");
+             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);
-             answer($c,$cont);
+             if ($outype eq 'txt') {
+              answer($c,$cont,"text/plain","");
+             } elsif ($outype eq 'xml') {
+              answer($c,$cont,"text/xml","");
+             } else {
+              die "Internal error, exiting!";
+             }
             }
            } 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>");
+            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>");
+           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";
@@ -326,8 +361,8 @@ sub finduris { # find uris for cic and theory trees generation
   }
  } elsif ($format eq "xml") { # XML output
   $content .= '<?xml version="1.0" encoding="ISO-8859-1"?>' . "\n";
-  $content .= '<!DOCTYPE ls SYSTEM ';
-  $content .= '"http://localhost:8081/getdtd?uri=ls.dtd">' . "\n\n";
+  $content .= "<!DOCTYPE ls SYSTEM ";
+  $content .= "\"$myownurl/getdtd?uri=ls.dtd\">" . "\n\n";
   $content .= "<ls>\n";
   foreach $key (sort(keys %dirs)) {
    $content .= "\t<section>$key</section>\n";
@@ -444,9 +479,8 @@ sub gzip {	# gzip the content argument and save it to filename argument
 	$gz->gzclose();
 }
 
-sub download
-{
- my ($remove_headers,$str,$url,$filename,$format) = @_;
+sub download {
+ my ($patch_dtd,$str,$url,$filename,$format) = @_;
  my ($gz, $buffer);
 
  #my $debug=1; # for DEBUG only
@@ -529,10 +563,7 @@ sub download
    }
    # $cont now contained uncompressed data
  }
- if ($remove_headers) {
-    $cont =~ s/<\?xml [^?]*\?>//sg;
-    $cont =~ s/<!DOCTYPE [^>]*>//sg;
- } else {
+ if ($patch_dtd eq "yes") {
     $cont =~ s/DOCTYPE (.*) SYSTEM\s+"http:\/\/www.cs.unibo.it\/helm\/dtd\//DOCTYPE $1 SYSTEM "$myownurl\/getdtd?uri=/g;
  }
  if ($format eq "gz") {
@@ -551,14 +582,26 @@ sub download
  return $cont;
 }
 
-sub answer
-{
- my ($c,$cont) = @_;
+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)
+   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