helm/interface/http_getter/http_getter.pl

   1 #!/usr/bin/perl
   2
   3 # next require defines: $helm_dir, $html_link
   4 # LUCA - 12 sep 2000
   5 # require "/usr/lib/helm/configuration.pl";
   6 require "/home/cadet/sacerdot/local/lib/helm/configuration.pl";
   7 use HTTP::Daemon;
   8 use HTTP::Status;
   9 use HTTP::Request;
  10 use LWP::UserAgent;
  11 use DB_File;
  12
  13 my $cont = "";
  14 my $d = new HTTP::Daemon LocalPort => 8081;
  15 tie(%map, 'DB_File', 'urls_of_uris.db', O_RDONLY, 0664);
  16 print "Please contact me at: <URL:", $d->url, ">\n";
  17 print "helm_dir: $helm_dir\n";
  18 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
  19 while (my $c = $d->accept) {
  20  if (fork() == 0) {
  21     while (my $r = $c->get_request) {
  22         #CSC: mancano i controlli di sicurezza
  23
  24         $cont = "";
  25         my $cicuri = $r->url;
  26         $cicuri =~ s/^[^?]*\?url=(.*)/$1/;
  27         print "*".$r->url."\n";
  28         my $http_method = $r->method;
  29         my $http_path = $r->url->path;
  30         if ($http_method eq 'GET' and $http_path eq "/get") {
  31             my $filename = $cicuri;
  32             $filename =~ s/cic:(.*)/$1/;
  33             $filename =~ s/theory:(.*)/$1/;
  34             $filename = $helm_dir.$filename.".xml";
  35             my $resolved = $map{$cicuri};
  36             print "$cicuri ==> $resolved ($filename)\n";
  37             if (stat($filename)) {
  38                print "Using local copy\n";
  39                open(FD, $filename);
  40                while(<FD>) { $cont .= $_; }
  41                close(FD);
  42                my $res = new HTTP::Response;
  43                $res->content($cont);
  44                $c->send_response($res);
  45             } else {
  46                print "Downloading\n";
  47                $ua = LWP::UserAgent->new;
  48                $request = HTTP::Request->new(GET => "$resolved");
  49                $response = $ua->request($request, \&callback);
  50
  51                print "Storing file\n";
  52                open(FD, $filename);
  53                print FD $cont;
  54                close(FD);
  55
  56                my $res = new HTTP::Response;
  57                $res->content($cont);
  58                $c->send_response($res);
  59             }
  60         } elsif ($http_method eq 'GET' and $http_path eq "/annotate") {
  61             my $do_annotate = ($cicuri =~ /\.ann$/);
  62             my $target_to_annotate = $cicuri;
  63             $target_to_annotate =~ s/(.*)\.ann$/$1/ if $do_annotate;
  64             my $filename = $cicuri;
  65             $filename =~ s/cic:(.*)/$1/;
  66             $filename =~ s/theory:(.*)/$1/;
  67             my $filename_target = $helm_dir.$filename if $do_annotate;
  68             $filename = $helm_dir.$filename.".xml";
  69             $filename_target =~ s/(.*)\.ann$/$1.xml/ if $do_annotate;
  70             my $resolved = $map{$cicuri};
  71             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
  72             if ($do_annotate) {
  73                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
  74             } else {
  75                print "$cicuri ==> $resolved ($filename)\n";
  76             }
  77
  78             # Retrieves the annotation
  79
  80             if (stat($filename)) {
  81                print "Using local copy for the annotation\n";
  82                open(FD, $filename);
  83                while(<FD>) { $cont .= $_; }
  84                close(FD);
  85             } else {
  86                print "Downloading the annotation\n";
  87                $ua = LWP::UserAgent->new;
  88                $request = HTTP::Request->new(GET => "$resolved");
  89                $response = $ua->request($request, \&callback);
  90
  91                print "Storing file for the annotation\n";
  92                open(FD, $filename);
  93                print FD $cont;
  94                close(FD);
  95             }
  96             my $annotation = $cont;
  97
  98             # Retrieves the target to annotate
  99
 100             $cont = "";
 101             if ($do_annotate) {
 102                if (stat($filename_target)) {
 103                   print "Using local copy for the file to annotate\n";
 104                   open(FD, $filename_target);
 105                   while(<FD>) { $cont .= $_; }
 106                   close(FD);
 107                } else {
 108                   print "Downloading the file to annotate\n";
 109                   $ua = LWP::UserAgent->new;
 110                   $request = HTTP::Request->new(GET => "$resolved_target");
 111                   $response = $ua->request($request, \&callback);
 112
 113                   print "Storing file for the file to annotate\n";
 114                   open(FD, $filename_target);
 115                   print FD $cont;
 116                   close(FD);
 117                }
 118             }
 119             my $target = $cont;
 120
 121             # Merging the annotation and the target
 122
 123             $target =~ s/<\?xml [^?]*\?>//sg;
 124             $target =~ s/<!DOCTYPE [^>]*>//sg;
 125             $annotation =~ s/<\?xml [^?]*\?>//sg;
 126             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 127             my $merged = <<EOT;
 128 <?xml version="1.0" encoding="UTF-8"?>
 129 <cicxml uri="$target_to_annotate">
 130 $target
 131 $annotation
 132 </cicxml>
 133 EOT
 134
 135             # Answering the client
 136
 137             my $res = new HTTP::Response;
 138             $res->content($merged);
 139             $c->send_response($res);
 140         } elsif ($http_method eq 'GET' and $http_path eq "/getwithtypes") {
 141             my $do_annotate = ($cicuri =~ /\.types$/);
 142             my $target_to_annotate = $cicuri;
 143             $target_to_annotate =~ s/(.*)\.types$/$1/ if $do_annotate;
 144             my $filename = $cicuri;
 145             $filename =~ s/cic:(.*)/$1/;
 146             $filename =~ s/theory:(.*)/$1/;
 147             my $filename_target = $helm_dir.$filename if $do_annotate;
 148             $filename = $helm_dir.$filename.".xml";
 149             $filename_target =~ s/(.*)\.types$/$1.xml/ if $do_annotate;
 150             my $resolved = $map{$cicuri};
 151             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
 152             if ($do_annotate) {
 153                print "GETWITHTYPES!!\n";
 154                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
 155              } else {
 156                print "$cicuri ==> $resolved ($filename)\n";
 157             }
 158
 159             # Retrieves the annotation
 160
 161             if (stat($filename)) {
 162                print "Using local copy for the types\n";
 163                open(FD, $filename);
 164                while(<FD>) { $cont .= $_; }
 165                close(FD);
 166             } else {
 167                print "Downloading the types\n";
 168                $ua = LWP::UserAgent->new;
 169                $request = HTTP::Request->new(GET => "$resolved");
 170                $response = $ua->request($request, \&callback);
 171
 172                print "Storing file for the types\n";
 173                open(FD, $filename);
 174                print FD $cont;
 175                close(FD);
 176             }
 177             my $annotation = $cont;
 178
 179             # Retrieves the target to annotate
 180
 181             $cont = "";
 182             my $target;
 183             if ($do_annotate) {
 184                if (stat($filename_target)) {
 185                   print "Using local copy for the file to type\n";
 186                   open(FD, $filename_target);
 187                   while(<FD>) { $cont .= $_; }
 188                   close(FD);
 189                } else {
 190                   print "Downloading the file to type\n";
 191                   $ua = LWP::UserAgent->new;
 192                   $request = HTTP::Request->new(GET => "$resolved_target");
 193                   $response = $ua->request($request, \&callback);
 194
 195                   print "Storing file for the file to type\n";
 196                   open(FD, $filename_target);
 197                   print FD $cont;
 198                   close(FD);
 199                }
 200                $target = $cont;
 201             } else {
 202                $target = $annotation;
 203                $annotation = "";
 204             }
 205
 206             # Merging the annotation and the target
 207
 208             $target =~ s/<\?xml [^?]*\?>//sg;
 209             $target =~ s/<!DOCTYPE [^>]*>//sg;
 210             $annotation =~ s/<\?xml [^?]*\?>//sg;
 211             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 212             my $merged = <<EOT;
 213 <?xml version="1.0" encoding="UTF-8"?>
 214 <cicxml uri="$target_to_annotate">
 215 $target
 216 <ALLTYPES>
 217 $annotation
 218 </ALLTYPES>
 219 </cicxml>
 220 EOT
 221
 222             # Answering the client
 223
 224             my $res = new HTTP::Response;
 225             $res->content($merged);
 226             $c->send_response($res);
 227          } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
 228             my $filename = $cicuri;
 229             $filename = $helm_dir."/dtd/".$filename;
 230             print "DTD: $cicuri ==> ($filename)\n";
 231             if (stat($filename)) {
 232                print "Using local copy\n";
 233                open(FD, $filename);
 234                while(<FD>) { $cont .= $_; }
 235                close(FD);
 236                my $res = new HTTP::Response;
 237                $res->content($cont);
 238                $c->send_response($res);
 239             } else {
 240                die "Could not find DTD!";
 241             }
 242         } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
 243             my $quoted_html_link = $html_link;
 244             $quoted_html_link =~ s/&/&amp;/g;
 245             $quoted_html_link =~ s/</&lt;/g;
 246             $quoted_html_link =~ s/>/&gt;/g;
 247             $quoted_html_link =~ s/'/&apos;/g;
 248             $quoted_html_link =~ s/"/&quot;/g;
 249             print "Configuration requested, returned #$quoted_html_link#\n";
 250             $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
 251             my $res = new HTTP::Response;
 252             $res->content($cont);
 253             $c->send_response($res);
 254         } else {
 255             print "INVALID REQUEST!!!!!\n";
 256             $c->send_error(RC_FORBIDDEN)
 257         }
 258     }
 259     $c->close;
 260     undef($c);
 261     print "\nCONNECTION CLOSED\n\n";
 262     exit;
 263   } # fork
 264 }
 265
 266 #================================
 267
 268 sub callback
 269 {
 270  my ($data) = @_;
 271  $cont .= $data;
 272 }