X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fhttp_getter%2Fhttp_getter.pl.in;h=e301963bcf65af3225a866a54c5a82306fc4cfdd;hb=fb158d51c621e55962a6139d03cd1678cfb2e8f1;hp=b1840c8f11df3fddf3dd37f08a6744a192c01e0f;hpb=abf66be35540a8bb8e96aa5ff24108dc569f4f3f;p=helm.git
diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index b1840c8f1..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,7 +107,7 @@ 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');
@@ -128,6 +129,9 @@ while (my $c = $d->accept) {
$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";
@@ -149,8 +153,18 @@ while (my $c = $d->accept) {
my $ciccontent = download($patch_dtd,"cic",$cicurl,$cicfilename,$answerformat);
# Answering the client
- answer($c,$ciccontent,$answerformat);
+ 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 = "\n\n";
+ if ($outputurl eq "") {
+ $cont .= "\n";
+ } else {
+ $cont .= "\n";
+ }
+ answer($c,$cont,"text/xml","");
} elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
my $filename = $inputuri;
$filename = $dtd_dir."/".$filename;
@@ -166,7 +180,7 @@ while (my $c = $d->accept) {
$cont .= $_;
}
close(FD);
- answer($c,$cont,"normal");
+ answer($c,$cont,"text/xml","");
} else {
die "Could not find DTD!";
}
@@ -181,7 +195,7 @@ while (my $c = $d->accept) {
$cont .= $_;
}
close(FD);
- answer($c,$cont,"normal");
+ answer($c,$cont,"text/plain","");
} else {
die "Could not find Style Configuration File!";
}
@@ -201,7 +215,7 @@ while (my $c = $d->accept) {
$cont .= $_;
}
close(FD);
- answer($c,$cont,"normal");
+ answer($c,$cont,"text/xml","");
} else {
die "Could not find XSLT!";
}
@@ -211,7 +225,7 @@ while (my $c = $d->accept) {
mk_urls_of_uris();
kill(USR1,getppid()); # signal changes to parent
print " done\n";
- answer($c,"Update done
","normal");
+ 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);
@@ -230,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,"Invalid output type, may be ".
- "\"txt\" or \"xml\"
","normal");
+ 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,"normal");
+ 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,"Invalid uri , may begin with ".
- "\"cic:\", \"theory:\" or \"*:\"
","normal");
+ 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,"HTTP Getter Version ".
- $VERSION."
","normal");
+ 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";
@@ -321,8 +361,8 @@ sub finduris { # find uris for cic and theory trees generation
}
} elsif ($format eq "xml") { # XML output
$content .= '' . "\n";
- $content .= '" . "\n\n";
+ $content .= "" . "\n\n";
$content .= "\n";
foreach $key (sort(keys %dirs)) {
$content .= "\t\n";
@@ -543,16 +583,25 @@ sub download {
}
sub answer {
- my ($c,$cont,$contype) = @_; # $contype must be "normal" or "gz"
+# 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" => "text/plain");
- if ($contype eq "gz") {
- $res->push_header("Content-Encoding" => "x-gzip");
- }
+ $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 = "$content
";
+ 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