# various variables
my ($HELM_LIB_PATH);
+my $cgi_dir = "@HELM_CGI_DIR@";
my (%map);
# First of all, let's load HELM configuration
my $ciccontent = download($patch_dtd,"cic",$cicurl,$cicfilename,$answerformat);
# Answering the client
+ if ($answerformat eq "normal") {
+ answer($c,$ciccontent,"text/xml","");
+ } else {
answer($c,$ciccontent,"text/xml","x-gzip");
+ }
}
} elsif ($http_method eq 'GET' and $http_path eq "/resolve") {
my $outputurl = $map{$inputuri};
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);
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);
} 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";
my ($uri,$localpart,$basepart,$dirname,$suffix,$flags,$key);
my (@itemz,@already_pushed_dir);
my (%objects,%dirs); # map uris to suffixes' flags
+ #my $debug=1; # for debug
print "FINDURIS, uritype: $uritype, uripattern: $uripattern, ".
- "format: $format\n\n";
+ "format: $format\n\n" if defined($debug);
if (($uritype eq "cic") or ($uritype eq "theory")) {
# get info only of one type: cic or theory
foreach (keys(%map)) { # select matching uris
$uri = $_;
- if ($uri =~ /^$uritype:$uripattern\//) {
- $localpart = $uri;
- $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
+ if ($uri =~ /^$uritype:$uripattern(\/|$|\.)/) {
+ if ($uri =~ /^$uritype:$uripattern\//) { # directory match
+ $localpart = $uri;
+ $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
+ } elsif ($uri =~ /^$uritype:$uripattern($|\.)/) { # file match
+ $localpart = $uri;
+ $localpart =~ s/^.*\/([^\/]*)/$1/;
+ } else {
+ die "Internal error, seems that requested match is none of ".
+ "directory match or file match";
+ }
+ print "LOCALPART: $localpart\n" if defined($debug);
if ($localpart =~ /^[^\/]*$/) { # no slash, an OBJECT
$basepart = $localpart;
- $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/; # remove exts .types or
+ $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/;
+ # remove exts .types or
# .types.ann
$flags = $objects{$basepart}; # get old flags
if ($localpart =~ /\.ann$/) {
}
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 "");
+ $res->push_header("Cache-Control" => "no-cache");
+ $res->push_header("Pragma" => "no-cache");
+ $res->push_header("Expires" => "0");
$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