--- /dev/null
+#!/usr/bin/perl
+
+# next require defines: $helm_dir, $html_link
+require "/usr/lib/helm/configuration.pl";
+use HTTP::Daemon;
+use HTTP::Status;
+use HTTP::Request;
+use LWP::UserAgent;
+use DB_File;
+
+my $cont = "";
+my $d = new HTTP::Daemon LocalPort => 8081;
+tie(%map, 'DB_File', 'urls_of_uris.db', O_RDONLY, 0664);
+print "Please contact me at: <URL:", $d->url, ">\n";
+print "helm_dir: $helm_dir\n";
+$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
+while (my $c = $d->accept) {
+ if (fork() == 0) {
+ while (my $r = $c->get_request) {
+ #CSC: mancano i controlli di sicurezza
+
+ $cont = "";
+ my $cicuri = $r->url;
+ $cicuri =~ s/^[^?]*\?url=(.*)/$1/;
+ print "*".$r->url."\n";
+ my $http_method = $r->method;
+ my $http_path = $r->url->path;
+ if ($http_method eq 'GET' and $http_path eq "/get") {
+ my $filename = $cicuri;
+ $filename =~ s/cic:(.*)/$1/;
+ $filename =~ s/theory:(.*)/$1/;
+ $filename = $helm_dir.$filename.".xml";
+ my $resolved = $map{$cicuri};
+ print "$cicuri ==> $resolved ($filename)\n";
+ if (stat($filename)) {
+ print "Using local copy\n";
+ open(FD, $filename);
+ while(<FD>) { $cont .= $_; }
+ close(FD);
+ my $res = new HTTP::Response;
+ $res->content($cont);
+ $c->send_response($res);
+ } else {
+ print "Downloading\n";
+ $ua = LWP::UserAgent->new;
+ $request = HTTP::Request->new(GET => "$resolved");
+ $response = $ua->request($request, \&callback);
+
+ print "Storing file\n";
+ open(FD, $filename);
+ print FD $cont;
+ close(FD);
+
+ my $res = new HTTP::Response;
+ $res->content($cont);
+ $c->send_response($res);
+ }
+ } elsif ($http_method eq 'GET' and $http_path eq "/annotate") {
+ my $do_annotate = ($cicuri =~ /\.ann$/);
+ my $target_to_annotate = $cicuri;
+ $target_to_annotate =~ s/(.*)\.ann$/$1/ if $do_annotate;
+ my $filename = $cicuri;
+ $filename =~ s/cic:(.*)/$1/;
+ $filename =~ s/theory:(.*)/$1/;
+ my $filename_target = $helm_dir.$filename if $do_annotate;
+ $filename = $helm_dir.$filename.".xml";
+ $filename_target =~ s/(.*)\.ann$/$1.xml/ if $do_annotate;
+ my $resolved = $map{$cicuri};
+ my $resolved_target = $map{$target_to_annotate} if $do_annotate;
+ if ($do_annotate) {
+ print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
+ } elsif ($http_method eq 'GET' and $http_path eq "/getwithtypes") {
+ my $do_annotate = ($cicuri =~ /\.types$/);
+ my $target_to_annotate = $cicuri;
+ $target_to_annotate =~ s/(.*)\.types$/$1/ if $do_annotate;
+ my $filename = $cicuri;
+ $filename =~ s/cic:(.*)/$1/;
+ $filename =~ s/theory:(.*)/$1/;
+ my $filename_target = $helm_dir.$filename if $do_annotate;
+ $filename = $helm_dir.$filename.".xml";
+ $filename_target =~ s/(.*)\.types$/$1.xml/ if $do_annotate;
+ my $resolved = $map{$cicuri};
+ my $resolved_target = $map{$target_to_annotate} if $do_annotate;
+ if ($do_annotate) {
+ print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
+ } else {
+ print "$cicuri ==> $resolved ($filename)\n";
+ }
+
+ # Retrieves the annotation
+
+ if (stat($filename)) {
+ print "Using local copy for the types\n";
+ open(FD, $filename);
+ while(<FD>) { $cont .= $_; }
+ close(FD);
+ } else {
+ print "Downloading the types\n";
+ $ua = LWP::UserAgent->new;
+ $request = HTTP::Request->new(GET => "$resolved");
+ $response = $ua->request($request, \&callback);
+
+ print "Storing file for the types\n";
+ open(FD, $filename);
+ print FD $cont;
+ close(FD);
+ }
+ my $annotation = $cont;
+
+ # Retrieves the target to annotate
+
+ $cont = "";
+ if ($do_annotate) {
+ if (stat($filename_target)) {
+ print "Using local copy for the file to type\n";
+ open(FD, $filename_target);
+ while(<FD>) { $cont .= $_; }
+ close(FD);
+ } else {
+ print "Downloading the file to type\n";
+ $ua = LWP::UserAgent->new;
+ $request = HTTP::Request->new(GET => "$resolved_target");
+ $response = $ua->request($request, \&callback);
+
+ print "Storing file for the file to type\n";
+ open(FD, $filename_target);
+ print FD $cont;
+ close(FD);
+ }
+ }
+ my $target = $cont;
+
+ # Merging the annotation and the target
+
+ $target =~ s/<\?xml [^?]*\?>//sg;
+ $target =~ s/<!DOCTYPE [^>]*>//sg;
+ $annotation =~ s/<\?xml [^?]*\?>//sg;
+ $annotation =~ s/<!DOCTYPE [^>]*>//sg;
+ my $merged = <<EOT;
+<?xml version="1.0" encoding="UTF-8"?>
+<cicxml uri="$target_to_annotate">
+$target
+<ALLTYPES>
+$annotation
+</ALLTYPES>
+</cicxml>
+EOT
+
+ # Answering the client
+
+ my $res = new HTTP::Response;
+ $res->content($merged);
+ $c->send_response($res);
+ } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
+ my $filename = $cicuri;
+ $filename = $helm_dir."/dtd/".$filename;
+ print "DTD: $cicuri ==> ($filename)\n";
+ if (stat($filename)) {
+ print "Using local copy\n";
+ open(FD, $filename);
+ while(<FD>) { $cont .= $_; }
+ close(FD);
+ my $res = new HTTP::Response;
+ $res->content($cont);
+ $c->send_response($res);
+ } else {
+ die "Could not find DTD!";
+ }
+ } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
+ my $quoted_html_link = $html_link;
+ $quoted_html_link =~ s/&/&/g;
+ $quoted_html_link =~ s/</</g;
+ $quoted_html_link =~ s/>/>/g;
+ $quoted_html_link =~ s/'/'/g;
+ $quoted_html_link =~ s/"/"/g;
+ print "Configuration requested, returned #$quoted_html_link#\n";
+ $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
+ my $res = new HTTP::Response;
+ $res->content($cont);
+ $c->send_response($res);
+ } else {
+ print "INVALID REQUEST!!!!!\n";
+ $c->send_error(RC_FORBIDDEN)
+ }
+ }
+ $c->close;
+ undef($c);
+ print "\nCONNECTION CLOSED\n\n";
+ exit;
+ } # fork
+}
+
+#================================
+
+sub callback
+{
+ my ($data) = @_;
+ $cont .= $data;
+}
projects / helm.git / blobdiff