+++ /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;
-}