[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1056.4.25 and 1.1088

version 1.1056.4.25, 2011/05/14 17:16:49 version 1.1088, 2010/09/30 16:42:33
Line 95  use Math::Random; Line 95  use Math::Random;
 use File::MMagic;  use File::MMagic;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use File::Copy;  
   
 my $readit;  my $readit;
 my $max_connection_retries = 10;     # Or some such value.  my $max_connection_retries = 10;     # Or some such value.
Line 196  sub get_server_timezone { Line 195  sub get_server_timezone {
     }      }
 }  }
   
 sub get_server_distarch {  
     my ($lonhost,$ignore_cache) = @_;  
     if (defined($lonhost)) {  
         if (!defined(&hostname($lonhost))) {  
             return;  
         }  
         my $cachetime = 12*3600;  
         if (!$ignore_cache) {  
             my ($distarch,$cached)=&is_cached_new('serverdistarch',$lonhost);  
             if (defined($cached)) {  
                 return $distarch;  
             }  
         }  
         my $rep = &reply('serverdistarch',$lonhost);  
         unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||  
                 $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||  
                 $rep eq '') {  
             return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);  
         }  
     }  
     return;  
 }  
   
 sub get_server_loncaparev {  sub get_server_loncaparev {
     my ($dom,$lonhost,$ignore_cache,$caller) = @_;      my ($dom,$lonhost,$ignore_cache,$caller) = @_;
     if (defined($lonhost)) {      if (defined($lonhost)) {
Line 287  sub get_server_homeID { Line 263  sub get_server_homeID {
     }      }
     my $cachetime = 12*3600;      my $cachetime = 12*3600;
     my $serverhomeID;      my $serverhomeID;
     if ($caller eq 'loncron') {      if ($caller eq 'loncron') { 
         my @machine_ids = &machine_ids($hostname);          my @machine_ids = &machine_ids($hostname);
         foreach my $id (@machine_ids) {          foreach my $id (@machine_ids) {
             my $response = &reply('serverhomeID',$id);              my $response = &reply('serverhomeID',$id);
Line 748  sub userload { Line 724  sub userload {
     return $userloadpercent;      return $userloadpercent;
 }  }
   
 # ------------------------------------------ Fight off request when overloaded  
   
 sub overloaderror {  
     my ($r,$checkserver)=@_;  
     unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }  
     my $loadavg;  
     if ($checkserver eq $perlvar{'lonHostID'}) {  
        open(my $loadfile,'/proc/loadavg');  
        $loadavg=<$loadfile>;  
        $loadavg =~ s/\s.*//g;  
        $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};  
        close($loadfile);  
     } else {  
        $loadavg=&reply('load',$checkserver);  
     }  
     my $overload=$loadavg-100;  
     if ($overload>0) {  
  $r->err_headers_out->{'Retry-After'}=$overload;  
         $r->log_error('Overload of '.$overload.' on '.$checkserver);  
         return 413;  
     }      
     return '';  
 }  
   
 # ------------------------------ Find server with least workload from spare.tab  # ------------------------------ Find server with least workload from spare.tab
   
 sub spareserver {  sub spareserver {
Line 789  sub spareserver { Line 741  sub spareserver {
     }      }
     foreach my $try_server (@{ $spareid{'primary'} }) {      foreach my $try_server (@{ $spareid{'primary'} }) {
         if ($uint_dom) {          if ($uint_dom) {
             next unless (&spare_can_host($udom,$uint_dom,$remotesessions,               next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
                                          $try_server));                                            $try_server));
         }          }
  ($spare_server, $lowest_load) =   ($spare_server, $lowest_load) =
     &compare_server_load($try_server, $spare_server, $lowest_load);      &compare_server_load($try_server, $spare_server, $lowest_load);
Line 831  sub compare_server_load { Line 783  sub compare_server_load {
     my $userloadans = &reply('userload',$try_server);      my $userloadans = &reply('userload',$try_server);
   
     if ($loadans !~ /\d/ && $userloadans !~ /\d/) {      if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
         return; #didn't get a number from the server   return; #didn't get a number from the server
     }      }
   
     my $load;      my $load;
Line 2223  sub allowuploaded { Line 2175  sub allowuploaded {
 #        path to file, source of file, instruction to parse file for objects,  #        path to file, source of file, instruction to parse file for objects,
 #        ref to hash for embedded objects,  #        ref to hash for embedded objects,
 #        ref to hash for codebase of java objects.  #        ref to hash for codebase of java objects.
 #        reference to scalar to accommodate mime type determined  
 #          from File::MMagic if $parser = parse.  
 #  #
 # output: url to file (if action was uploaddoc),   # output: url to file (if action was uploaddoc), 
 #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)  #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)
Line 2251  sub allowuploaded { Line 2201  sub allowuploaded {
 #  #
   
 sub process_coursefile {  sub process_coursefile {
     my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase,      my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
         $mimetype)=@_;  
     my $fetchresult;      my $fetchresult;
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
     if ($action eq 'propagate') {      if ($action eq 'propagate') {
Line 2280  sub process_coursefile { Line 2229  sub process_coursefile {
             close($fh);              close($fh);
             if ($parser eq 'parse') {              if ($parser eq 'parse') {
                 my $mm = new File::MMagic;                  my $mm = new File::MMagic;
                 my $type = $mm->checktype_filename($filepath.'/'.$fname);                  my $mime_type = $mm->checktype_filename($filepath.'/'.$fname);
                 if ($type eq 'text/html') {                  if ($mime_type eq 'text/html') {
                     my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);                      my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
                     unless ($parse_result eq 'ok') {                      unless ($parse_result eq 'ok') {
                         &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);                          &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
                     }                      }
                 }                  }
                 if (ref($mimetype)) {  
                     $$mimetype = $type;  
                 }  
             }              }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,              $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $home);                                   $home);
Line 2405  sub resizeImage { Line 2351  sub resizeImage {
   
 # --------------- Take an uploaded file and put it into the userfiles directory  # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}  # input: $formname - the contents of the file are in $env{"form.$formname"}
 #                    the desired filename is in $env{"form.$formname.filename"}  #                    the desired filenam is in $env{"form.$formname.filename"}
 #        $context - possible values: coursedoc, existingfile, overwrite,   #        $coursedoc - if true up to the current course
 #                                    canceloverwrite, or ''.  #                     if false
 #                   if 'coursedoc': upload to the current course  
 #                   if 'existingfile': write file to tmp/overwrites directory  
 #                   if 'canceloverwrite': delete file written to tmp/overwrites directory  
 #                   $context is passed as argument to &finishuserfileupload   
 #        $subdir - directory in userfile to store the file into  #        $subdir - directory in userfile to store the file into
 #        $parser - instruction to parse file for objects ($parser = parse)      #        $parser - instruction to parse file for objects ($parser = parse)    
 #        $allfiles - reference to hash for embedded objects  #        $allfiles - reference to hash for embedded objects
Line 2422  sub resizeImage { Line 2364  sub resizeImage {
 #        $thumbheight - height (pixels) of thumbnail to make for uploaded image  #        $thumbheight - height (pixels) of thumbnail to make for uploaded image
 #        $resizewidth - width (pixels) to which to resize uploaded image  #        $resizewidth - width (pixels) to which to resize uploaded image
 #        $resizeheight - height (pixels) to which to resize uploaded image  #        $resizeheight - height (pixels) to which to resize uploaded image
 #        $mimetype - reference to scalar to accommodate mime type determined  
 #                    from File::MMagic if $parser = parse.  
 #   # 
 # output: url of file in userspace, or error: <message>   # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse  #             or /adm/notfound.html if failure to upload occurse
   
 sub userfileupload {  sub userfileupload {
     my ($formname,$context,$subdir,$parser,$allfiles,$codebase,$destuname,      my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,
         $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight,$mimetype)=@_;          $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }      if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};      my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);      $fname=&clean_filename($fname);
     # See if there is anything left  # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
     # Files uploaded to help request form, or uploaded to "create course" page are handled differently      chop($env{'form.'.$formname});
     if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) ||      if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) { #files uploaded to help request form are handled differently
         (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) ||  
          ($context eq 'existingfile') || ($context eq 'canceloverwrite')) {  
         my $now = time;          my $now = time;
         my $filepath;          my $filepath = 'tmp/helprequests/'.$now;
         if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) {          my @parts=split(/\//,$filepath);
              $filepath = 'tmp/helprequests/'.$now;          my $fullpath = $perlvar{'lonDaemons'};
         } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) {          for (my $i=0;$i<@parts;$i++) {
              $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}.              $fullpath .= '/'.$parts[$i];
                          '_'.$env{'user.domain'}.'/pending';              if ((-e $fullpath)!=1) {
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {                  mkdir($fullpath,0777);
             my ($docuname,$docudom);  
             if ($destudom) {  
                 $docudom = $destudom;  
             } else {  
                 $docudom = $env{'user.domain'};  
             }  
             if ($destuname) {  
                 $docuname = $destuname;  
             } else {  
                 $docuname = $env{'user.name'};  
             }  
             if (exists($env{'form.group'})) {  
                 $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};  
                 $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};  
             }  
             $filepath = 'tmp/overwrites/'.$docudom.'/'.$docuname.'/'.$subdir;  
             if ($context eq 'canceloverwrite') {  
                 my $tempfile =  $perlvar{'lonDaemons'}.'/'.$filepath.'/'.$fname;  
                 if (-e  $tempfile) {  
                     my @info = stat($tempfile);  
                     if ($info[9] eq $env{'form.timestamp'}) {  
                         unlink($tempfile);  
                     }  
                 }  
                 return;  
             }              }
         }          }
         # Create the directory if not present          open(my $fh,'>'.$fullpath.'/'.$fname);
           print $fh $env{'form.'.$formname};
           close($fh);
           return $fullpath.'/'.$fname;
       } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) { #files uploaded to create course page are handled differently
           my $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}.
                          '_'.$env{'user.domain'}.'/pending';
         my @parts=split(/\//,$filepath);          my @parts=split(/\//,$filepath);
         my $fullpath = $perlvar{'lonDaemons'};          my $fullpath = $perlvar{'lonDaemons'};
         for (my $i=0;$i<@parts;$i++) {          for (my $i=0;$i<@parts;$i++) {
Line 2487  sub userfileupload { Line 2406  sub userfileupload {
         open(my $fh,'>'.$fullpath.'/'.$fname);          open(my $fh,'>'.$fullpath.'/'.$fname);
         print $fh $env{'form.'.$formname};          print $fh $env{'form.'.$formname};
         close($fh);          close($fh);
         if ($context eq 'existingfile') {          return $fullpath.'/'.$fname;
             my @info = stat($fullpath.'/'.$fname);  
             return ($fullpath.'/'.$fname,$info[9]);  
         } else {  
             return $fullpath.'/'.$fname;  
         }  
     }      }
     if ($subdir eq 'scantron') {      if ($subdir eq 'scantron') {
         $fname = 'scantron_orig_'.$fname;          $fname = 'scantron_orig_'.$fname;
     } else {      } else {   
   # Create the directory if not present
         $fname="$subdir/$fname";          $fname="$subdir/$fname";
     }      }
     if ($context eq 'coursedoc') {      if ($coursedoc) {
  my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};   my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
  my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};   my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
         if ($env{'form.folder'} =~ m/^(default|supplemental)/) {          if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
             return &finishuserfileupload($docuname,$docudom,              return &finishuserfileupload($docuname,$docudom,
  $formname,$fname,$parser,$allfiles,   $formname,$fname,$parser,$allfiles,
  $codebase,$thumbwidth,$thumbheight,   $codebase,$thumbwidth,$thumbheight,
                                          $resizewidth,$resizeheight,$context,$mimetype);                                           $resizewidth,$resizeheight);
         } else {          } else {
             $fname=$env{'form.folder'}.'/'.$fname;              $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,              return &process_coursefile('uploaddoc',$docuname,$docudom,
        $fname,$formname,$parser,         $fname,$formname,$parser,
        $allfiles,$codebase,$mimetype);         $allfiles,$codebase);
         }          }
     } elsif (defined($destuname)) {      } elsif (defined($destuname)) {
         my $docuname=$destuname;          my $docuname=$destuname;
Line 2519  sub userfileupload { Line 2434  sub userfileupload {
  return &finishuserfileupload($docuname,$docudom,$formname,$fname,   return &finishuserfileupload($docuname,$docudom,$formname,$fname,
      $parser,$allfiles,$codebase,       $parser,$allfiles,$codebase,
                                      $thumbwidth,$thumbheight,                                       $thumbwidth,$thumbheight,
                                      $resizewidth,$resizeheight,$context,$mimetype);                                       $resizewidth,$resizeheight);
           
     } else {      } else {
         my $docuname=$env{'user.name'};          my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};          my $docudom=$env{'user.domain'};
Line 2530  sub userfileupload { Line 2446  sub userfileupload {
  return &finishuserfileupload($docuname,$docudom,$formname,$fname,   return &finishuserfileupload($docuname,$docudom,$formname,$fname,
      $parser,$allfiles,$codebase,       $parser,$allfiles,$codebase,
                                      $thumbwidth,$thumbheight,                                       $thumbwidth,$thumbheight,
                                      $resizewidth,$resizeheight,$context,$mimetype);                                       $resizewidth,$resizeheight);
     }      }
 }  }
   
 sub finishuserfileupload {  sub finishuserfileupload {
     my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase,      my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase,
         $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context,$mimetype) = @_;          $thumbwidth,$thumbheight,$resizewidth,$resizeheight) = @_;
     my $path=$docudom.'/'.$docuname.'/';      my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};      my $filepath=$perlvar{'lonDocRoot'};
       
Line 2562  sub finishuserfileupload { Line 2478  sub finishuserfileupload {
     print STDERR ('Failed to create '.$filepath.'/'.$file."\n");      print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
     return '/adm/notfound.html';      return '/adm/notfound.html';
  }   }
         if ($context eq 'overwrite') {   if (!print FH ($env{'form.'.$formname})) {
             my $source =  $perlvar{'lonDaemons'}.'/tmp/overwrites/'.$docudom.'/'.$docuname.'/'.$fname;  
             my $target = $filepath.'/'.$file;  
             if (-e $source) {  
                 my @info = stat($source);  
                 if ($info[9] eq $env{'form.timestamp'}) {  
                     unless (&File::Copy::move($source,$target)) {  
                         &logthis('Failed to overwrite '.$filepath.'/'.$file);  
                         return "Moving from $source failed";  
                     }  
                 } else {  
                     return "Temporary file: $source had unexpected date/time for last modification";  
                 }  
             } else {  
                 return "Temporary file: $source missing";  
             }  
  } elsif (!print FH ($env{'form.'.$formname})) {  
     &logthis('Failed to write to '.$filepath.'/'.$file);      &logthis('Failed to write to '.$filepath.'/'.$file);
     print STDERR ('Failed to write to '.$filepath.'/'.$file."\n");      print STDERR ('Failed to write to '.$filepath.'/'.$file."\n");
     return '/adm/notfound.html';      return '/adm/notfound.html';
Line 2594  sub finishuserfileupload { Line 2494  sub finishuserfileupload {
     }      }
     if ($parser eq 'parse') {      if ($parser eq 'parse') {
         my $mm = new File::MMagic;          my $mm = new File::MMagic;
         my $type = $mm->checktype_filename($filepath.'/'.$file);          my $mime_type = $mm->checktype_filename($filepath.'/'.$file);
         if ($type eq 'text/html') {          if ($mime_type eq 'text/html') {
             my $parse_result = &extract_embedded_items($filepath.'/'.$file,              my $parse_result = &extract_embedded_items($filepath.'/'.$file,
                                                        $allfiles,$codebase);                                                         $allfiles,$codebase);
             unless ($parse_result eq 'ok') {              unless ($parse_result eq 'ok') {
Line 2603  sub finishuserfileupload { Line 2503  sub finishuserfileupload {
            ' for embedded media: '.$parse_result);              ' for embedded media: '.$parse_result); 
             }              }
         }          }
         if (ref($mimetype)) {  
             $$mimetype = $type;  
         }  
     }      }
     if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {      if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
         my $input = $filepath.'/'.$file;          my $input = $filepath.'/'.$file;
Line 3139  sub get_my_roles { Line 3036  sub get_my_roles {
     unless (defined($uname)) { $uname=$env{'user.name'}; }      unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }      unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my (%dumphash,%nothide);      my (%dumphash,%nothide);
     if ($context eq 'userroles') {       if ($context eq 'userroles') {
         my $extra = &freeze_escape({'skipcheck' => 1});          my $extra = &freeze_escape({'skipcheck' => 1});
         %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);          %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);
     } else {      } else {
Line 3469  sub get_domain_roles { Line 3366  sub get_domain_roles {
     return %personnel;      return %personnel;
 }  }
   
 # ----------------------------------------------------------- Check out an item  # ----------------------------------------------------------- Interval timing 
   
 sub get_first_access {  sub get_first_access {
     my ($type,$argsymb)=@_;      my ($type,$argsymb)=@_;
Line 3505  sub set_first_access { Line 3402  sub set_first_access {
     return 'already_set';      return 'already_set';
 }  }
   
 sub checkout {  
     my ($symb,$tuname,$tudom,$tcrsid)=@_;  
     my $now=time;  
     my $lonhost=$perlvar{'lonHostID'};  
     my $infostr=&escape(  
                  'CHECKOUTTOKEN&'.  
                  $tuname.'&'.  
                  $tudom.'&'.  
                  $tcrsid.'&'.  
                  $symb.'&'.  
  $now.'&'.$ENV{'REMOTE_ADDR'});  
     my $token=&reply('tmpput:'.$infostr,$lonhost);  
     if ($token=~/^error\:/) {   
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
         return '';   
     }  
   
     $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;  
     $token=~tr/a-z/A-Z/;  
   
     my %infohash=('resource.0.outtoken' => $token,  
                   'resource.0.checkouttime' => $now,  
                   'resource.0.outremote' => $ENV{'REMOTE_ADDR'});  
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {  
        return '';  
     } else {  
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
     }      
   
     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),  
                          &escape('Checkout '.$infostr.' - '.  
                                                  $token)) ne 'ok') {  
  return '';  
     } else {  
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
     }  
     return $token;  
 }  
   
 # ------------------------------------------------------------ Check in an item  
   
 sub checkin {  
     my $token=shift;  
     my $now=time;  
     my ($ta,$tb,$lonhost)=split(/\*/,$token);  
     $lonhost=~tr/A-Z/a-z/;  
     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;  
     $dtoken=~s/\W/\_/g;  
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=  
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));  
   
     unless (($tuname) && ($tudom)) {  
         &logthis('Check in '.$token.' ('.$dtoken.') failed');  
         return '';  
     }  
       
     unless (&allowed('mgr',$tcrsid)) {  
         &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.  
                  $env{'user.name'}.' - '.$env{'user.domain'});  
         return '';  
     }  
   
     my %infohash=('resource.0.intoken' => $token,  
                   'resource.0.checkintime' => $now,  
                   'resource.0.inremote' => $ENV{'REMOTE_ADDR'});  
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {  
        return '';  
     }      
   
     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),  
                          &escape('Checkin - '.$token)) ne 'ok') {  
  return '';  
     }  
   
     return ($symb,$tuname,$tudom,$tcrsid);      
 }  
   
 # --------------------------------------------- Set Expire Date for Spreadsheet  # --------------------------------------------- Set Expire Date for Spreadsheet
   
 sub expirespread {  sub expirespread {
Line 4334  sub set_userprivs { Line 4146  sub set_userprivs {
     my $adv=0;      my $adv=0;
     my %grouproles = ();      my %grouproles = ();
     if (keys(%{$allgroups}) > 0) {      if (keys(%{$allgroups}) > 0) {
         my @groupkeys;          my @groupkeys; 
         foreach my $role (keys(%{$allroles})) {          foreach my $role (keys(%{$allroles})) {
             push(@groupkeys,$role);              push(@groupkeys,$role);
         }          }
Line 4410  sub role_status { Line 4222  sub role_status {
                             my %userroles = (                              my %userroles = (
                                 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend                                  'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
                             );                              );
                             @rolecodes = ('cm');                              @rolecodes = ('cm'); 
                             my $spec=$$role.'.'.$$where;                              my $spec=$$role.'.'.$$where;
                             my ($tdummy,$tdomain,$trest)=split(/\//,$$where);                              my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
                             if ($$role =~ /^cr\//) {                              if ($$role =~ /^cr\//) {
Line 4427  sub role_status { Line 4239  sub role_status {
                                 my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);                                  my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
                                 if (keys(%course_roles) > 0) {                                  if (keys(%course_roles) > 0) {
                                     my ($tnum) = ($trest =~ /^($match_courseid)/);                                      my ($tnum) = ($trest =~ /^($match_courseid)/);
                                     if ($tdomain ne '' && $tnum ne '') {                                      if ($tdomain ne '' && $tnum ne '') { 
                                         foreach my $key (keys(%course_roles)) {                                          foreach my $key (keys(%course_roles)) {
                                             if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {                                              if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {
                                                 my $crsrole = $1;                                                  my $crsrole = $1;
Line 5112  sub is_portfolio_file { Line 4924  sub is_portfolio_file {
 }  }
   
 sub usertools_access {  sub usertools_access {
     my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref) = @_;      my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
     my ($access,%tools);      my ($access,%tools);
     if ($context eq '') {      if ($context eq '') {
         $context = 'tools';          $context = 'tools';
Line 5259  sub is_advanced_user { Line 5071  sub is_advanced_user {
     my ($udom,$uname) = @_;      my ($udom,$uname) = @_;
     if ($udom ne '' && $uname ne '') {      if ($udom ne '' && $uname ne '') {
         if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {          if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
             return $env{'user.adv'};              return $env{'user.adv'};  
         }          }
     }      }
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);      my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
Line 5777  sub allowed { Line 5589  sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};         my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
    =~/\Q$rolecode\E/) {     =~/\Q$rolecode\E/) {
            if (($priv ne 'pch') && ($priv ne 'plc')) {     if ($priv ne 'pch') { 
        &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.         &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.   'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
  $env{'request.course.id'});   $env{'request.course.id'});
Line 5787  sub allowed { Line 5599  sub allowed {
   
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
    =~/\Q$unamedom\E/) {     =~/\Q$unamedom\E/) {
            if (($priv ne 'pch') && ($priv ne 'plc')) {     if ($priv ne 'pch') { 
        &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.         &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
  'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.   'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
  $env{'request.course.id'});   $env{'request.course.id'});
Line 5801  sub allowed { Line 5613  sub allowed {
    if ($thisallowed=~/R/) {     if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];         my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {         if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
            if (($priv ne 'pch') && ($priv ne 'plc')) {     if ($priv ne 'pch') { 
        &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.         &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);   'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
    }     }
Line 6154  sub auto_get_sections { Line 5966  sub auto_get_sections {
 }  }
   
 sub auto_new_course {  sub auto_new_course {
     my ($cnum,$cdom,$inst_course_id,$owner,$coowners) = @_;      my ($cnum,$cdom,$inst_course_id,$owner) = @_;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
     my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.&escape($owner).':'.$cdom.':'.&escape($coowners),$homeserver));      my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver));
     return $response;      return $response;
 }  }
   
Line 6902  sub modifyuser { Line 6714  sub modifyuser {
     }      }
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
              $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.       $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :               (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified').                                        ' desiredhome not specified'). 
              ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.               ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
Line 7048  sub modifyuser { Line 6860  sub modifyuser {
         return 'ok';          return 'ok';
     }      }
     my $reply = &put('environment', \%names, $udom,$uname);      my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') {      if ($reply ne 'ok') { 
         return 'error: '.$reply;          return 'error: '.$reply;
     }      }
     if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {      if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
Line 7373  sub store_userdata { Line 7185  sub store_userdata {
                     $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';                      $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
                 }                  }
                 $namevalue=~s/\&$//;                  $namevalue=~s/\&$//;
                 $result =  &reply("store:$udom:$uname:$namespace:$datakey:".                  $result =  &reply("store:$env{'user.domain'}:$env{'user.name'}:".
                                   $namevalue,$uhome);                                    "$namespace:$datakey:$namevalue",$uhome);
             }              }
         } else {          } else {
             $result = 'error: data to store was not a hash reference';               $result = 'error: data to store was not a hash reference'; 
Line 7427  sub diskusage { Line 7239  sub diskusage {
 }  }
   
 sub is_locked {  sub is_locked {
     my ($file_name, $domain, $user, $which) = @_;      my ($file_name, $domain, $user) = @_;
     my @check;      my @check;
     my $is_locked;      my $is_locked;
     push(@check,$file_name);      push @check, $file_name;
     my %locked = &get('file_permissions',\@check,      my %locked = &get('file_permissions',\@check,
       $env{'user.domain'},$env{'user.name'});        $env{'user.domain'},$env{'user.name'});
     my ($tmp)=keys(%locked);      my ($tmp)=keys(%locked);
Line 7439  sub is_locked { Line 7251  sub is_locked {
     if (ref($locked{$file_name}) eq 'ARRAY') {      if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'false';          $is_locked = 'false';
         foreach my $entry (@{$locked{$file_name}}) {          foreach my $entry (@{$locked{$file_name}}) {
            if (ref($entry) eq 'ARRAY') {             if (ref($entry) eq 'ARRAY') { 
                $is_locked = 'true';                 $is_locked = 'true';
                if (ref($which) eq 'ARRAY') {                 last;
                    push(@{$which},$entry);  
                } else {  
                    last;  
                }  
            }             }
        }         }
     } else {      } else {
         $is_locked = 'false';          $is_locked = 'false';
     }      }
     return $is_locked;  
 }  }
   
 sub declutter_portfile {  sub declutter_portfile {
Line 8594  sub add_prefix_and_part { Line 8401  sub add_prefix_and_part {
 # ---------------------------------------------------------------- Get metadata  # ---------------------------------------------------------------- Get metadata
   
 my %metaentry;  my %metaentry;
   my %importedpartids;
 sub metadata {  sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 8601  sub metadata { Line 8409  sub metadata {
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||       ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$}) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) {
  return undef;   return undef;
     }      }
     if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/})       if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) 
Line 8620  sub metadata { Line 8428  sub metadata {
  if (defined($cached)) { return $result->{':'.$what}; }   if (defined($cached)) { return $result->{':'.$what}; }
     }      }
     {      {
   # Imported parts would go here
           my %importedids=();
           my @origfileimportpartids=();
           my $importedparts=0;
 #  #
 # Is this a recursive call for a library?  # Is this a recursive call for a library?
 #  #
Line 8703  sub metadata { Line 8515  sub metadata {
 # This is not a package - some other kind of start tag  # This is not a package - some other kind of start tag
 #  #
     my $entry=$token->[1];      my $entry=$token->[1];
     my $unikey;      my $unikey='';
     if ($entry eq 'import') {  
  $unikey='';  
     } else {  
  $unikey=$entry;  
     }  
     $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});  
   
     if (defined($token->[2]->{'id'})) {   
  $unikey.='_'.$token->[2]->{'id'};   
     }  
   
     if ($entry eq 'import') {      if ($entry eq 'import') {
 #  #
 # Importing a library here  # Importing a library here
 #  #
                           my $location=$parser->get_text('/import');
                           my $dir=$filename;
                           $dir=~s|[^/]*$||;
                           $location=&filelocation($dir,$location);
                          
                           my $importmode=$token->[2]->{'importmode'};
                           if ($importmode eq 'problem') {
   # Import as problem/response
                              $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
                           } elsif ($importmode eq 'part') {
   # Import as part(s)
                              $importedparts=1;
   # We need to get the original file and the imported file to get the part order correct
   # Good news: we do not need to worry about nested libraries, since parts cannot be nested
   # Load and inspect original file
                              if ($#origfileimportpartids<0) {
                                 undef(%importedpartids);
                                 my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                 my $origfile=&getfile($origfilelocation);
                                 @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                              }
   
   # Load and inspect imported file
                              my $impfile=&getfile($location);
                              my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                              if ($#impfilepartids>=0) {
   # This problem had parts
                                  $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);
                              } else {
   # Importing by turning a single problem into a problem part
   # It gets the import-tags ID as part-ID
                                  $unikey=&add_prefix_and_part($prefix,$token->[2]->{'id'});
                                  $importedpartids{$token->[2]->{'id'}}=$token->[2]->{'id'};
                              }
                           } else {
   # Normal import
                              $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
                              if (defined($token->[2]->{'id'})) {
                                 $unikey.='_'.$token->[2]->{'id'};
                              }
                           }
   
  if ($depthcount<20) {   if ($depthcount<20) {
     my $location=$parser->get_text('/import');  
     my $dir=$filename;  
     $dir=~s|[^/]*$||;  
     $location=&filelocation($dir,$location);  
     my $metadata =       my $metadata = 
  &metadata($uri,'keys', $location,$unikey,   &metadata($uri,'keys', $location,$unikey,
   $depthcount+1);    $depthcount+1);
Line 8731  sub metadata { Line 8571  sub metadata {
  $metaentry{':'.$meta}=$metaentry{':'.$meta};   $metaentry{':'.$meta}=$metaentry{':'.$meta};
  $metathesekeys{$meta}=1;   $metathesekeys{$meta}=1;
     }      }
  }  
     } else {                           }
       } else {
   #
   # Not importing, some other kind of non-package, non-library start tag
   # 
                           $unikey=$entry.&add_prefix_and_part($prefix,$token->[2]->{'part'});
                           if (defined($token->[2]->{'id'})) {
                               $unikey.='_'.$token->[2]->{'id'};
                           }
  if (defined($token->[2]->{'name'})) {    if (defined($token->[2]->{'name'})) { 
     $unikey.='_'.$token->[2]->{'name'};       $unikey.='_'.$token->[2]->{'name'}; 
  }   }
Line 8806  sub metadata { Line 8654  sub metadata {
     grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));      grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
  $metaentry{':packages'} = join(',',@uniq_packages);   $metaentry{':packages'} = join(',',@uniq_packages);
   
           if ($importedparts) {
   # We had imported parts and need to rebuild partorder
              $metaentry{':partorder'}='';
              $metathesekeys{'partorder'}=1;
              for (my $index=0;$index<$#origfileimportpartids;$index+=2) {
                  if ($origfileimportpartids[$index] eq 'part') {
   # original part, part of the problem
                     $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];
                  } else {
   # we have imported parts at this position
                     $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};
                  }
              }
              $metaentry{':partorder'}=~s/^\,//;
           }
   
  $metaentry{':keys'} = join(',',keys(%metathesekeys));   $metaentry{':keys'} = join(',',keys(%metathesekeys));
  &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);   &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
  $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);   $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
Line 8991  sub symbverify { Line 8855  sub symbverify {
         }          }
         my $ids=$bighash{'ids_'.&clutter($thisurl)};          my $ids=$bighash{'ids_'.&clutter($thisurl)};
         unless ($ids) {           unless ($ids) { 
            my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;             $ids=$bighash{'ids_/'.$thisurl};
            $ids=$bighash{$idkey};  
         }          }
         if ($ids) {          if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)  # ------------------------------------------------------------------- Has ID(s)
Line 9005  sub symbverify { Line 8868  sub symbverify {
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)    &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) {      eq $symb) { 
    if (($env{'request.role.adv'}) ||     if (($env{'request.role.adv'}) ||
        ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||         $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
        ($thisurl eq '/adm/navmaps')) {  
        $okay=1;          $okay=1; 
    }     }
        }         }
Line 10085  sub get_dns { Line 9947  sub get_dns {
     my $loaded;      my $loaded;
     my %name_to_host;      my %name_to_host;
     my %internetdom;      my %internetdom;
     my %LC_dns_serv;  
   
     sub parse_hosts_tab {      sub parse_hosts_tab {
  my ($file) = @_;   my ($file) = @_;
  foreach my $configline (@$file) {   foreach my $configline (@$file) {
     next if ($configline =~ /^(\#|\s*$ )/x);      next if ($configline =~ /^(\#|\s*$ )/x);
             chomp($configline);      next if ($configline =~ /^\^/);
             if ($configline =~ /^\^/) {      chomp($configline);
                 if ($configline =~ /^\^([\w.\-]+)/) {  
                     $LC_dns_serv{$1} = 1;  
                 }  
                 next;  
             }  
     my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);      my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     if ($id && $domain && $role && $name) {      if ($id && $domain && $role && $name) {
Line 10179  sub get_dns { Line 10035  sub get_dns {
     }      }
   
     sub unique_library {      sub unique_library {
         #2x reverse removes all hostnames that appear more than once   #2x reverse removes all hostnames that appear more than once
         my %unique = reverse &all_library();          my %unique = reverse &all_library();
         return reverse %unique;          return reverse %unique;
     }      }
Line 10209  sub get_dns { Line 10065  sub get_dns {
   
     sub get_unique_servers {      sub get_unique_servers {
         my %unique = reverse &get_servers(@_);          my %unique = reverse &get_servers(@_);
         return reverse %unique;   return reverse %unique;
     }      }
   
     sub host_domain {      sub host_domain {
Line 10745  $checkdefauth is optional (value is 1 if Line 10601  $checkdefauth is optional (value is 1 if
    authenticate user using default authentication method, and allow     authenticate user using default authentication method, and allow
    account creation if username does not have account in the domain).     account creation if username does not have account in the domain).
 $clientcancheckhost is optional (value is 1 if checking whether the  $clientcancheckhost is optional (value is 1 if checking whether the
    server can host will occur on the client side in lonauth.pm).     server can host will occur on the client side in lonauth.pm).   
   
 =item *  =item *
 X<homeserver()>  X<homeserver()>
Line 11494  userfileupload(): main rotine for puttin Line 11350  userfileupload(): main rotine for puttin
            filename, and the contents of the file to create/modifed exist             filename, and the contents of the file to create/modifed exist
            the filename is in $env{'form.'.$formname.'.filename'} and the             the filename is in $env{'form.'.$formname.'.filename'} and the
            contents of the file is located in $env{'form.'.$formname}             contents of the file is located in $env{'form.'.$formname}
  context - if coursedoc, store the file in the course of the active role   coursedoc - if true, store the file in the course of the active role
              of the current user;               of the current user
            if 'existingfile': store in 'overwrites' in /home/httpd/perl/tmp  
            if 'canceloverwrite': delete file in tmp/overwrites directory  
  subdir - required - subdirectory to put the file in under ../userfiles/   subdir - required - subdirectory to put the file in under ../userfiles/
          if undefined, it will be placed in "unknown"           if undefined, it will be placed in "unknown"
   
Line 11519  returns: the new clean filename Line 11373  returns: the new clean filename
   
 =item *  =item *
   
 finishuserfileupload(): routine that creates and sends the file to  finishuserfileupload(): routine that creaes and sends the file to
 userspace, probably shouldn't be called directly  userspace, probably shouldn't be called directly
   
   docuname: username or courseid of destination for the file    docuname: username or courseid of destination for the file
   docudom: domain of user/course of destination for the file    docudom: domain of user/course of destination for the file
   formname: same as for userfileupload()    formname: same as for userfileupload()
   fname: filename (including subdirectories) for the file    fname: filename (inculding subdirectories) for the file
   parser: if 'parse', will parse (html) file to extract references to objects, links etc.  
   allfiles: reference to hash used to store objects found by parser  
   codebase: reference to hash used for codebases of java objects found by parser  
   thumbwidth: width (pixels) of thumbnail to be created for uploaded image  
   thumbheight: height (pixels) of thumbnail to be created for uploaded image  
   resizewidth: width to be used to resize image using resizeImage from ImageMagick  
   resizeheight: height to be used to resize image using resizeImage from ImageMagick  
   context: if 'overwrite', will move the uploaded file from its temporary location to  
             userfiles to facilitate overwriting a previously uploaded file with same name.  
   mimetype: reference to scalar to accommodate mime type determined  
             from File::MMagic if $parser = parse.  
   
  returns either the url of the uploaded file (/uploaded/....) if successful   returns either the url of the uploaded file (/uploaded/....) if successful
  and /adm/notfound.html if unsuccessful (or an error message if context    and /adm/notfound.html if unsuccessful
  was 'overwrite').  
   
   
 =item *  =item *
   
Removed from v.1.1056.4.25  
changed lines
  Added in v.1.1088

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>