helm/interface/http_getter/http_getter.pl

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