[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.1172.2.52 and 1.1278

version 1.1172.2.52, 2014/06/25 18:44:10 version 1.1278, 2015/03/30 21:13:24
Line 75  use LWP::UserAgent(); Line 75  use LWP::UserAgent();
 use HTTP::Date;  use HTTP::Date;
 use Image::Magick;  use Image::Magick;
   
   
   use Encode;
   
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir  use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);              %managerstab);
Line 109  require Exporter; Line 112  require Exporter;
 our @ISA = qw (Exporter);  our @ISA = qw (Exporter);
 our @EXPORT = qw(%env);  our @EXPORT = qw(%env);
   
   
 # ------------------------------------ Logging (parameters, docs, slots, roles)  # ------------------------------------ Logging (parameters, docs, slots, roles)
 {  {
     my $logid;      my $logid;
Line 123  our @EXPORT = qw(%env); Line 127  our @EXPORT = qw(%env);
  $logid ++;   $logid ++;
         my $now = time();          my $now = time();
  my $id=$now.'00000'.$$.'00000'.$logid;   my $id=$now.'00000'.$$.'00000'.$logid;
         my $logentry = {          my $logentry = { 
                          $id => {                            $id => {
                                   'exe_uname' => $env{'user.name'},                                     'exe_uname' => $env{'user.name'},
                                   'exe_udom'  => $env{'user.domain'},                                     'exe_udom'  => $env{'user.domain'},
                                   'exe_time'  => $now,                                     'exe_time'  => $now,
                                   'exe_ip'    => $ENV{'REMOTE_ADDR'},                                     'exe_ip'    => $ENV{'REMOTE_ADDR'},
                                   'delflag'   => $delflag,                                     'delflag'   => $delflag,
                                   'logentry'  => $storehash,                                     'logentry'  => $storehash,
                                   'uname'     => $uname,                                     'uname'     => $uname,
                                   'udom'      => $udom,                                     'udom'      => $udom,
                                 }                                    }
                        };                         };
         return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);   return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
     }      }
 }  }
   
Line 356  sub remote_devalidate_cache { Line 360  sub remote_devalidate_cache {
     my $items;      my $items;
     return unless (ref($cachekeys) eq 'ARRAY');      return unless (ref($cachekeys) eq 'ARRAY');
     my $cachestr = join('&',@{$cachekeys});      my $cachestr = join('&',@{$cachekeys});
     return &reply('devalidatecache:'.&escape($cachestr),$lonhost);      my $response = &reply('devalidatecache:'.&escape($cachestr),$lonhost);
       return $response;
 }  }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
Line 974  sub choose_server { Line 979  sub choose_server {
         }          }
     }      }
     foreach my $lonhost (keys(%servers)) {      foreach my $lonhost (keys(%servers)) {
         my $loginvia;  
         if ($skiploadbal) {          if ($skiploadbal) {
             if (ref($balancers) eq 'HASH') {              if (ref($balancers) eq 'HASH') {
                 next if (exists($balancers->{$lonhost}));                  next if (exists($balancers->{$lonhost}));
             }              }
         }          }   
           my $loginvia;
         if ($checkloginvia) {          if ($checkloginvia) {
             $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};              $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
             if ($loginvia) {              if ($loginvia) {
Line 1174  sub spare_can_host { Line 1179  sub spare_can_host {
     my ($udom,$uint_dom,$remotesessions,$try_server)=@_;      my ($udom,$uint_dom,$remotesessions,$try_server)=@_;
     my $canhost=1;      my $canhost=1;
     my @intdoms;      my @intdoms;
     my $internet_names = &Apache::lonnet::get_internet_names($try_server);      my $internet_names = &get_internet_names($try_server);
     if (ref($internet_names) eq 'ARRAY') {      if (ref($internet_names) eq 'ARRAY') {
         @intdoms = @{$internet_names};          @intdoms = @{$internet_names};
     }      }
     unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {      unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {
         my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server);          my $try_server_hostname = &hostname($try_server);
         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);          my $serverhomeID = &get_server_homeID($try_server_hostname);
         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);          my $serverhomedom = &host_domain($serverhomeID);
         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server);          my %defdomdefaults = &get_domain_defaults($serverhomedom);
           my $remoterev = &get_server_loncaparev(undef,$try_server);
         $canhost = &can_host_session($udom,$try_server,$remoterev,          $canhost = &can_host_session($udom,$try_server,$remoterev,
                                      $remotesessions,                                       $remotesessions,
                                      $defdomdefaults{'hostedsessions'});                                       $defdomdefaults{'hostedsessions'});
Line 1297  sub check_loadbalancing { Line 1303  sub check_loadbalancing {
         }          }
     }      }
     if (ref($result) eq 'HASH') {      if (ref($result) eq 'HASH') {
         ($is_balancer,$currtargets,$currrules) =          ($is_balancer,$currtargets,$currrules) = 
             &check_balancer_result($result,@hosts);              &check_balancer_result($result,@hosts);
         if ($is_balancer) {          if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {              if (ref($currrules) eq 'HASH') {
Line 1356  sub check_loadbalancing { Line 1362  sub check_loadbalancing {
             }              }
         }          }
         if (ref($result) eq 'HASH') {          if (ref($result) eq 'HASH') {
             ($is_balancer,$currtargets,$currrules) =              ($is_balancer,$currtargets,$currrules) = 
                 &check_balancer_result($result,@hosts);                  &check_balancer_result($result,@hosts);
             if ($is_balancer) {              if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {                  if (ref($currrules) eq 'HASH') {
Line 1412  sub check_loadbalancing { Line 1418  sub check_loadbalancing {
             $is_balancer = 0;              $is_balancer = 0;
             if ($uname ne '' && $udom ne '') {              if ($uname ne '' && $udom ne '') {
                 if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {                  if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
                       
                     &appenv({'user.loadbalexempt'     => $lonhost,                      &appenv({'user.loadbalexempt'     => $lonhost,  
                              'user.loadbalcheck.time' => time});                               'user.loadbalcheck.time' => time});
                 }                  }
             }              }
Line 1602  sub idput { Line 1608  sub idput {
     }      }
 }  }
   
 # ---------------------------------------- Delete unwanted IDs from ids.db file  # ---------------------------------------- Delete unwanted IDs from ids.db file 
   
 sub iddel {  sub iddel {
     my ($udom,$idshashref,$uhome)=@_;      my ($udom,$idshashref,$uhome)=@_;
Line 1647  sub dump_dom { Line 1653  sub dump_dom {
   
 sub get_dom {  sub get_dom {
     my ($namespace,$storearr,$udom,$uhome)=@_;      my ($namespace,$storearr,$udom,$uhome)=@_;
       return if ($udom eq 'public');
     my $items='';      my $items='';
     foreach my $item (@$storearr) {      foreach my $item (@$storearr) {
         $items.=&escape($item).'&';          $items.=&escape($item).'&';
Line 1654  sub get_dom { Line 1661  sub get_dom {
     $items=~s/\&$//;      $items=~s/\&$//;
     if (!$udom) {      if (!$udom) {
         $udom=$env{'user.domain'};          $udom=$env{'user.domain'};
           return if ($udom eq 'public');
         if (defined(&domain($udom,'primary'))) {          if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');              $uhome=&domain($udom,'primary');
         } else {          } else {
Line 2068  sub get_domain_defaults { Line 2076  sub get_domain_defaults {
         }          }
     }      }
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {      if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
           $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
           $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};
           $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};
           if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
               $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
           }
         foreach my $type (@coursetypes) {          foreach my $type (@coursetypes) {
             if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {              if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
                 unless ($type eq 'community') {                  unless ($type eq 'community') {
Line 2077  sub get_domain_defaults { Line 2091  sub get_domain_defaults {
             if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {              if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                 $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};                  $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
             }              }
               if ($domdefaults{'postsubmit'} eq 'on') {
                   if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
                       $domdefaults{$type.'postsubtimeout'} = 
                           $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; 
                   }
               }
         }          }
     }      }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {      if (ref($domconfig{'usersessions'}) eq 'HASH') {
Line 2118  sub get_domain_defaults { Line 2138  sub get_domain_defaults {
     if (ref($domconfig{'coursecategories'}) eq 'HASH') {      if (ref($domconfig{'coursecategories'}) eq 'HASH') {
         $domdefaults{'catauth'} = 'std';          $domdefaults{'catauth'} = 'std';
         $domdefaults{'catunauth'} = 'std';          $domdefaults{'catunauth'} = 'std';
         if ($domconfig{'coursecategories'}{'auth'}) {          if ($domconfig{'coursecategories'}{'auth'}) { 
             $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};              $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};
         }          }
         if ($domconfig{'coursecategories'}{'unauth'}) {          if ($domconfig{'coursecategories'}{'unauth'}) {
Line 2715  sub ssi { Line 2735  sub ssi {
     &Apache::lonenc::check_encrypt(\$fn);      &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {      if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);        $request=new HTTP::Request('POST',&absolute_url().$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));        $request->content(join('&',map { 
               my $name = escape($_);
               "$name=" . ( ref($form{$_}) eq 'ARRAY' 
               ? join("&$name=", map {escape($_) } @{$form{$_}}) 
               : &escape($form{$_}) );    
           } keys(%form)));
     } else {      } else {
       $request=new HTTP::Request('GET',&absolute_url().$fn);        $request=new HTTP::Request('GET',&absolute_url().$fn);
     }      }
   
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response= $ua->request($request);      my $response= $ua->request($request);
       my $content = $response->content;
   
   
     if (wantarray) {      if (wantarray) {
  return ($response->content, $response);   return ($content, $response);
     } else {      } else {
  return $response->content;   return $content;
     }      }
 }  }
   
Line 2757  sub allowuploaded { Line 2785  sub allowuploaded {
 #  #
 # Determine if the current user should be able to edit a particular resource,  # Determine if the current user should be able to edit a particular resource,
 # when viewing in course context.  # when viewing in course context.
 # (a) When viewing resource used to determine if "Edit" item is included in  # (a) When viewing resource used to determine if "Edit" item is included in 
 #     Functions.  #     Functions.
 # (b) When displaying folder contents in course editor, used to determine if  # (b) When displaying folder contents in course editor, used to determine if
 #     "Edit" link will be displayed alongside resource.  #     "Edit" link will be displayed alongside resource.
Line 2765  sub allowuploaded { Line 2793  sub allowuploaded {
 #  input: six args -- filename (decluttered), course number, course domain,  #  input: six args -- filename (decluttered), course number, course domain,
 #                   url, symb (if registered) and group (if this is a group  #                   url, symb (if registered) and group (if this is a group
 #                   item -- e.g., bulletin board, group page etc.).  #                   item -- e.g., bulletin board, group page etc.).
 #  output: array of five scalars --  #  output: array of five scalars -- 
 #          $cfile -- url for file editing if editable on current server  #          $cfile -- url for file editing if editable on current server
 #          $home -- homeserver of resource (i.e., for author if published,  #          $home -- homeserver of resource (i.e., for author if published,
 #                                           or course if uploaded.).  #                                           or course if uploaded.).
 #          $switchserver --  1 if server switch will be needed.  #          $switchserver --  1 if server switch will be needed.
 #          $forceedit -- 1 if icon/link should be to go to edit mode  #          $forceedit -- 1 if icon/link should be to go to edit mode 
 #          $forceview -- 1 if icon/link should be to go to view mode  #          $forceview -- 1 if icon/link should be to go to view mode
 #  #
   
Line 2859  sub can_edit_resource { Line 2887  sub can_edit_resource {
                     $forceedit = 1;                      $forceedit = 1;
                 }                  }
                 $cfile = $resurl;                  $cfile = $resurl;
             } elsif (($resurl ne '') && (&is_on_map($resurl))) {              } elsif (($resurl ne '') && (&is_on_map($resurl))) { 
                 if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {                  if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {
                     $incourse = 1;                      $incourse = 1;
                     if ($env{'form.forceedit'}) {                      if ($env{'form.forceedit'}) {
Line 2890  sub can_edit_resource { Line 2918  sub can_edit_resource {
                 }                  }
             } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {              } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
                 my $template = '/res/lib/templates/simpleproblem.problem';                  my $template = '/res/lib/templates/simpleproblem.problem';
                 if (&is_on_map($template)) {                  if (&is_on_map($template)) { 
                     $incourse = 1;                      $incourse = 1;
                     $forceview = 1;                      $forceview = 1;
                     $cfile = $template;                      $cfile = $template;
Line 2937  sub can_edit_resource { Line 2965  sub can_edit_resource {
                 $cfile=$file;                  $cfile=$file;
             }              }
         }          }
         if (($cfile ne '') && (!$incourse || $uploaded) &&          if (($cfile ne '') && (!$incourse || $uploaded) && 
             (($home ne '') && ($home ne 'no_host'))) {              (($home ne '') && ($home ne 'no_host'))) {
             my @ids=&current_machine_ids();              my @ids=&current_machine_ids();
             unless (grep(/^\Q$home\E$/,@ids)) {              unless (grep(/^\Q$home\E$/,@ids)) {
Line 2964  sub in_course { Line 2992  sub in_course {
     if ($hideprivileged) {      if ($hideprivileged) {
         my $skipuser;          my $skipuser;
         my %coursehash = &coursedescription($cdom.'_'.$cnum);          my %coursehash = &coursedescription($cdom.'_'.$cnum);
         my @possdoms = ($cdom);          my @possdoms = ($cdom);  
         if ($coursehash{'checkforpriv'}) {          if ($coursehash{'checkforpriv'}) { 
             push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));              push(@possdoms,split(/,/,$coursehash{'checkforpriv'})); 
         }          }
         if (&privileged($uname,$udom,\@possdoms)) {          if (&privileged($uname,$udom,\@possdoms)) {
             $skipuser = 1;              $skipuser = 1;
Line 3470  sub extract_embedded_items { Line 3498  sub extract_embedded_items {
     }      }
     if (lc($tagname) eq 'a') {      if (lc($tagname) eq 'a') {
                 unless (($attr->{'href'} =~ /^#/) || ($attr->{'href'} eq '')) {                  unless (($attr->{'href'} =~ /^#/) || ($attr->{'href'} eq '')) {
     &add_filetype($allfiles,$attr->{'href'},'href');                      &add_filetype($allfiles,$attr->{'href'},'href');
                 }                  }
     }      }
             if (lc($tagname) eq 'script') {              if (lc($tagname) eq 'script') {
Line 4141  sub get_my_roles { Line 4169  sub get_my_roles {
             } else {              } else {
                 my $possdoms = [$domain];                  my $possdoms = [$domain];
                 if (ref($roledoms) eq 'ARRAY') {                  if (ref($roledoms) eq 'ARRAY') {
                    push(@{$possdoms},@{$roledoms});                     push(@{$possdoms},@{$roledoms}); 
                 }                  }
                 if (&privileged($username,$domain,$possdoms,\@privroles)) {                  if (&privileged($username,$domain,$possdoms,\@privroles)) {
                     if (!$nothide{$username.':'.$domain}) {                      if (!$nothide{$username.':'.$domain}) {
Line 4249  sub courseiddump { Line 4277  sub courseiddump {
     if (($domfilter eq '') ||      if (($domfilter eq '') ||
  (&host_domain($tryserver) eq $domfilter)) {   (&host_domain($tryserver) eq $domfilter)) {
                 my $rep;                  my $rep;
                 if (grep { $_ eq $tryserver } &current_machine_ids()) {                  if (grep { $_ eq $tryserver } current_machine_ids()) {
                     $rep = &LONCAPA::Lond::dump_course_id_handler(                      $rep = LONCAPA::Lond::dump_course_id_handler(
                         join(":", (&host_domain($tryserver), $sincefilter,                          join(":", (&host_domain($tryserver), $sincefilter, 
                                 &escape($descfilter), &escape($instcodefilter),                                  &escape($descfilter), &escape($instcodefilter), 
                                 &escape($ownerfilter), &escape($coursefilter),                                  &escape($ownerfilter), &escape($coursefilter),
                                 &escape($typefilter), &escape($regexp_ok),                                  &escape($typefilter), &escape($regexp_ok), 
                                 $as_hash, &escape($selfenrollonly),                                  $as_hash, &escape($selfenrollonly), 
                                 &escape($catfilter), $showhidden, $caller,                                  &escape($catfilter), $showhidden, $caller, 
                                 &escape($cloner), &escape($cc_clone), $cloneonly,                                  &escape($cloner), &escape($cc_clone), $cloneonly, 
                                 &escape($createdbefore), &escape($createdafter),                                  &escape($createdbefore), &escape($createdafter), 
                                 &escape($creationcontext), $domcloner, $hasuniquecode)));                                  &escape($creationcontext), $domcloner, $hasuniquecode)));
                 } else {                  } else {
                     $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.                      $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
Line 4273  sub courseiddump { Line 4301  sub courseiddump {
                              &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,                               &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,
                              $tryserver);                               $tryserver);
                 }                  }
                        
                 my @pairs=split(/\&/,$rep);                  my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {                  foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);                      my ($key,$value)=split(/\=/,$item,2);
Line 4472  sub set_first_access { Line 4500  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 4928  sub tmprestore { Line 4870  sub tmprestore {
 # ----------------------------------------------------------------------- Store  # ----------------------------------------------------------------------- Store
   
 sub store {  sub store {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
     my $home='';      my $home='';
   
     if ($stuname) { $home=&homeserver($stuname,$domain); }      if ($stuname) { $home=&homeserver($stuname,$domain); }
Line 4958  sub store { Line 4900  sub store {
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
     return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");      return reply("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }  }
   
 # -------------------------------------------------------------- Critical Store  # -------------------------------------------------------------- Critical Store
   
 sub cstore {  sub cstore {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
     my $home='';      my $home='';
   
     if ($stuname) { $home=&homeserver($stuname,$domain); }      if ($stuname) { $home=&homeserver($stuname,$domain); }
Line 4995  sub cstore { Line 4937  sub cstore {
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
     return critical      return critical
                 ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");                  ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }  }
   
 # --------------------------------------------------------------------- Restore  # --------------------------------------------------------------------- Restore
Line 5151  sub privileged { Line 5093  sub privileged {
     my $now = time;      my $now = time;
     my $roles;      my $roles;
     if (ref($possroles) eq 'ARRAY') {      if (ref($possroles) eq 'ARRAY') {
         $roles = $possroles;          $roles = $possroles; 
     } else {      } else {
         $roles = ['dc','su'];          $roles = ['dc','su'];
     }      }
Line 5175  sub privileged { Line 5117  sub privileged {
         my %rolesdump = &dump("roles", $domain, $username) or return 0;          my %rolesdump = &dump("roles", $domain, $username) or return 0;
         my $now = time;          my $now = time;
   
         for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) {          for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys(%rolesdump)}) {
             my ($trole, $tend, $tstart) = split(/_/, $role);              my ($trole, $tend, $tstart) = split(/_/, $role);
             if (grep(/^\Q$trole\E$/,@{$roles})) {              if (grep(/^\Q$trole\E$/,@{$roles})) {
                 return 1 unless ($tend && $tend < $now)                  return 1 unless ($tend && $tend < $now) 
                         or ($tstart && $tstart > $now);                          or ($tstart && $tstart > $now);
             }              }
         }          }
Line 5216  sub privileged_by_domain { Line 5158  sub privileged_by_domain {
                         my ($trole,$uname,$udom,$rest) = split(/:/,$item,4);                          my ($trole,$uname,$udom,$rest) = split(/:/,$item,4);
                         my ($end,$start) = split(/:/,$dompersonnel{$server}{$item});                          my ($end,$start) = split(/:/,$dompersonnel{$server}{$item});
                         next if ($end && $end < $now);                          next if ($end && $end < $now);
                         $privileged{$dom}{$trole}{$uname.':'.$udom} =                          $privileged{$dom}{$trole}{$uname.':'.$udom} = 
                             $dompersonnel{$server}{$item};                              $dompersonnel{$server}{$item};
                     }                      }
                 }                  }
Line 5264  sub rolesinit { Line 5206  sub rolesinit {
     my %allroles=();      my %allroles=();
     my %allgroups=();      my %allgroups=();
   
     for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) {      for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};          my $role = $rolesdump{$area};
         $area =~ s/\_\w\w$//;          $area =~ s/\_\w\w$//;
   
Line 5687  sub unserialize { Line 5629  sub unserialize {
     return {} if $rep =~ /^error/;      return {} if $rep =~ /^error/;
   
     my %returnhash=();      my %returnhash=();
     foreach my $item (split(/\&/,$rep)) {   foreach my $item (split(/\&/,$rep)) {
         my ($key, $value) = split(/=/, $item, 2);      my ($key, $value) = split(/=/, $item, 2);
         $key = unescape($key) unless $escapedkeys;      $key = unescape($key) unless $escapedkeys;
         next if $key =~ /^error: 2 /;      next if $key =~ /^error: 2 /;
         $returnhash{$key} = &thaw_unescape($value);      $returnhash{$key} = &thaw_unescape($value);
     }   }
       #return %returnhash;
     return \%returnhash;      return \%returnhash;
 }  }        
   
 # see Lond::dump_with_regexp  # see Lond::dump_with_regexp
 # if $escapedkeys hash keys won't get unescaped.  # if $escapedkeys hash keys won't get unescaped.
Line 5704  sub dump { Line 5647  sub dump {
     if (!$uname) { $uname=$env{'user.name'}; }      if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
   
     my $reply;  
     if (grep { $_ eq $uhome } &current_machine_ids()) {  
         # user is hosted on this machine  
         $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,  
                     $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});  
         return %{&unserialize($reply, $escapedkeys)};  
     }  
     if ($regexp) {      if ($regexp) {
  $regexp=&escape($regexp);          $regexp=&escape($regexp);
     } else {      } else {
  $regexp='.';          $regexp='.';
       }
       if (grep { $_ eq $uhome } current_machine_ids()) {
           # user is hosted on this machine
           my $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
                       $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
           return %{unserialize($reply, $escapedkeys)};
     }      }
     my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);      my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
     my @pairs=split(/\&/,$rep);      my @pairs=split(/\&/,$rep);
Line 5722  sub dump { Line 5664  sub dump {
     if (!($rep =~ /^error/ )) {      if (!($rep =~ /^error/ )) {
  foreach my $item (@pairs) {   foreach my $item (@pairs) {
     my ($key,$value)=split(/=/,$item,2);      my ($key,$value)=split(/=/,$item,2);
             $key = &unescape($key) unless ($escapedkeys);          $key = unescape($key) unless $escapedkeys;
           #$key = &unescape($key);
     next if ($key =~ /^error: 2 /);      next if ($key =~ /^error: 2 /);
     $returnhash{$key}=&thaw_unescape($value);      $returnhash{$key}=&thaw_unescape($value);
  }   }
Line 5766  sub currentdump { Line 5709  sub currentdump {
    my $rep;     my $rep;
   
    if (grep { $_ eq $uhome } current_machine_ids()) {     if (grep { $_ eq $uhome } current_machine_ids()) {
        $rep = LONCAPA::Lond::dump_profile_database(join(":", ($sdom, $sname,         $rep = LONCAPA::Lond::dump_profile_database(join(":", ($sdom, $sname, 
                    $courseid)));                     $courseid)));
    } else {     } else {
        $rep = reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);         $rep = reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);
Line 5892  sub newput { Line 5835  sub newput {
 # ---------------------------------------------------------  putstore interface  # ---------------------------------------------------------  putstore interface
   
 sub putstore {  sub putstore {
    my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;     my ($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }     if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
Line 5906  sub putstore { Line 5849  sub putstore {
    my $reply =     my $reply =
        &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",         &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
       $uhome);        $uhome);
      if (($tolog) && ($reply eq 'ok')) {
          my $namevalue='';
          foreach my $key (keys(%{$storehash})) {
              $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
          }
          $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
                        '&host='.&escape($perlvar{'lonHostID'}).
                        '&version='.$esc_v.
                        '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
          &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
      }
    if ($reply eq 'unknown_cmd') {     if ($reply eq 'unknown_cmd') {
        # gfall back to way things use to be done         # gfall back to way things use to be done
        return &old_putstore($namespace,$symb,$version,$storehash,$udomain,         return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
Line 6014  sub tmpdel { Line 5968  sub tmpdel {
     return &reply("tmpdel:$token",$server);      return &reply("tmpdel:$token",$server);
 }  }
   
 # ------------------------------------------------------------ get_timebased_id  # ------------------------------------------------------------ get_timebased_id 
   
 sub get_timebased_id {  sub get_timebased_id {
     my ($prefix,$keyid,$namespace,$cdom,$cnum,$idtype,$who,$locktries,      my ($prefix,$keyid,$namespace,$cdom,$cnum,$idtype,$who,$locktries,
         $maxtries) = @_;          $maxtries) = @_;
     my ($newid,$error,$dellock);      my ($newid,$error,$dellock);
     unless (($prefix =~ /^\w+$/) && ($keyid =~ /^\w+$/) && ($namespace ne '')) {      unless (($prefix =~ /^\w+$/) && ($keyid =~ /^\w+$/) && ($namespace ne '')) {  
         return ('','ok','invalid call to get suffix');          return ('','ok','invalid call to get suffix');
     }      }
   
Line 6034  sub get_timebased_id { Line 5988  sub get_timebased_id {
     if (!$maxtries) {      if (!$maxtries) {
         $maxtries = 10;          $maxtries = 10;
     }      }
       
     if (($cdom eq '') || ($cnum eq '')) {      if (($cdom eq '') || ($cnum eq '')) {
         if ($env{'request.course.id'}) {          if ($env{'request.course.id'}) {
             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};              $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
Line 6064  sub get_timebased_id { Line 6018  sub get_timebased_id {
         my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);          my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
         my $id = time;          my $id = time;
         $newid = $id;          $newid = $id;
           if ($idtype eq 'addcode') {
               $newid .= &sixnum_code();
           }
         my $idtries = 0;          my $idtries = 0;
         while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) {          while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) {
             if ($idtype eq 'concat') {              if ($idtype eq 'concat') {
                 $newid = $id.$idtries;                  $newid = $id.$idtries;
               } elsif ($idtype eq 'addcode') {
                   $newid = $newid.&sixnum_code();
             } else {              } else {
                 $newid ++;                  $newid ++;
             }              }
Line 6084  sub get_timebased_id { Line 6043  sub get_timebased_id {
                 $error = 'error saving new item: '.$putresult;                  $error = 'error saving new item: '.$putresult;
             }              }
         } else {          } else {
                undef($newid);
              $error = ('error: no unique suffix available for the new item ');               $error = ('error: no unique suffix available for the new item ');
         }          }
 #  remove lock  #  remove lock
Line 6092  sub get_timebased_id { Line 6052  sub get_timebased_id {
     } else {      } else {
         $error = "error: could not obtain lockfile\n";          $error = "error: could not obtain lockfile\n";
         $dellock = 'ok';          $dellock = 'ok';
           if (($prefix eq 'paste') && ($namespace eq 'courseeditor') && ($keyid eq 'num')) {
               $dellock = 'nolock';
           }
     }      }
     return ($newid,$dellock,$error);      return ($newid,$dellock,$error);
 }  }
   
   sub sixnum_code {
       my $code;
       for (0..6) {
           $code .= int( rand(9) );
       }
       return $code;
   }
   
 # -------------------------------------------------- portfolio access checking  # -------------------------------------------------- portfolio access checking
   
 sub portfolio_access {  sub portfolio_access {
     my ($requrl) = @_;      my ($requrl,$clientip) = @_;
     my (undef,$udom,$unum,$file_name,$group) = &parse_portfolio_url($requrl);      my (undef,$udom,$unum,$file_name,$group) = &parse_portfolio_url($requrl);
     my $result = &get_portfolio_access($udom,$unum,$file_name,$group);      my $result = &get_portfolio_access($udom,$unum,$file_name,$group,$clientip);
     if ($result) {      if ($result) {
         my %setters;          my %setters;
         if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {          if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
Line 6127  sub portfolio_access { Line 6098  sub portfolio_access {
 }  }
   
 sub get_portfolio_access {  sub get_portfolio_access {
     my ($udom,$unum,$file_name,$group,$access_hash) = @_;      my ($udom,$unum,$file_name,$group,$clientip,$access_hash) = @_;
   
     if (!ref($access_hash)) {      if (!ref($access_hash)) {
  my $current_perms = &get_portfile_permissions($udom,$unum);   my $current_perms = &get_portfile_permissions($udom,$unum);
Line 6136  sub get_portfolio_access { Line 6107  sub get_portfolio_access {
  $access_hash = $access_controls{$file_name};   $access_hash = $access_controls{$file_name};
     }      }
   
     my ($public,$guest,@domains,@users,@courses,@groups);      my ($public,$guest,@domains,@users,@courses,@groups,@ips);
     my $now = time;      my $now = time;
     if (ref($access_hash) eq 'HASH') {      if (ref($access_hash) eq 'HASH') {
         foreach my $key (keys(%{$access_hash})) {          foreach my $key (keys(%{$access_hash})) {
Line 6160  sub get_portfolio_access { Line 6131  sub get_portfolio_access {
                 push(@courses,$key);                  push(@courses,$key);
             } elsif ($scope eq 'group') {              } elsif ($scope eq 'group') {
                 push(@groups,$key);                  push(@groups,$key);
               } elsif ($scope eq 'ip') {
                   push(@ips,$key);
             }              }
         }          }
         if ($public) {          if ($public) {
             return 'ok';              return 'ok';
           } elsif (@ips > 0) {
               my $allowed;
               foreach my $ipkey (@ips) {
                   if (ref($access_hash->{$ipkey}{'ip'}) eq 'ARRAY') {
                       if (&Apache::loncommon::check_ip_acc(join(',',@{$access_hash->{$ipkey}{'ip'}}),$clientip)) {
                           $allowed = 1;
                           last; 
                       }
                   }
               }
               if ($allowed) {
                   return 'ok';
               }
         }          }
         if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {          if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
             if ($guest) {              if ($guest) {
Line 6385  sub usertools_access { Line 6371  sub usertools_access {
   
     my ($toolstatus,$inststatus,$envkey);      my ($toolstatus,$inststatus,$envkey);
     if ($context eq 'requestauthor') {      if ($context eq 'requestauthor') {
         $envkey = $context;          $envkey = $context; 
     } else {      } else {
         $envkey = $context.'.'.$tool;          $envkey = $context.'.'.$tool;
     }      }
Line 6647  sub customaccess { Line 6633  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri,$symb,$role)=@_;      my ($priv,$uri,$symb,$role,$clientip)=@_;
     my $ver_orguri=$uri;      my $ver_orguri=$uri;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
Line 6874  sub allowed { Line 6860  sub allowed {
  && $thisallowed ne 'F'    && $thisallowed ne 'F' 
  && $thisallowed ne '2'   && $thisallowed ne '2'
  && &is_portfolio_url($uri)) {   && &is_portfolio_url($uri)) {
  $thisallowed = &portfolio_access($uri);   $thisallowed = &portfolio_access($uri,$clientip);
     }      }
       
 # Full access at system, domain or course-wide level? Exit.  # Full access at system, domain or course-wide level? Exit.
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
  return 'F';   return 'F';
Line 7463  sub metadata_query { Line 7449  sub metadata_query {
     my @server_list = (defined($server_array) ? @$server_array      my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );                                                : keys(%libserv) );
     for my $server (@server_list) {      for my $server (@server_list) {
         my $domains = '';          my $domains = ''; 
         if (ref($domains_hash) eq 'HASH') {          if (ref($domains_hash) eq 'HASH') {
             $domains = $domains_hash->{$server};                  $domains = $domains_hash->{$server}; 
         }          }
  unless ($custom or $customshow) {   unless ($custom or $customshow) {
     my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);      my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);
Line 8010  sub auto_crsreq_update { Line 7996  sub auto_crsreq_update {
                             ':'.&escape($action).':'.&escape($ownername).':'.                              ':'.&escape($action).':'.&escape($ownername).':'.
                             &escape($ownerdomain).':'.&escape($fullname).':'.                              &escape($ownerdomain).':'.&escape($fullname).':'.
                             &escape($title).':'.&escape($code).':'.                              &escape($title).':'.&escape($code).':'.
                             &escape($accessstart).':'.&escape($accessend).':'.$info,$homeserver);                              &escape($accessstart).':'.&escape($accessend).':'.$info,
                               $homeserver);
         unless ($response =~ /(con_lost|error|no_such_host|refused)/) {          unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
             my @items = split(/&/,$response);              my @items = split(/&/,$response);
             foreach my $item (@items) {              foreach my $item (@items) {
Line 8290  sub assignrole { Line 8277  sub assignrole {
                         }                          }
                     }                      }
                 } elsif ($context eq 'requestauthor') {                  } elsif ($context eq 'requestauthor') {
                     if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&                      if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && 
                         ($url eq '/'.$udom.'/') && ($role eq 'au')) {                          ($url eq '/'.$udom.'/') && ($role eq 'au')) {
                         if ($env{'environment.requestauthor'} eq 'automatic') {                          if ($env{'environment.requestauthor'} eq 'automatic') {
                             $refused = '';                              $refused = '';
Line 8298  sub assignrole { Line 8285  sub assignrole {
                             my %domdefaults = &get_domain_defaults($udom);                              my %domdefaults = &get_domain_defaults($udom);
                             if (ref($domdefaults{'requestauthor'}) eq 'HASH') {                              if (ref($domdefaults{'requestauthor'}) eq 'HASH') {
                                 my $checkbystatus;                                  my $checkbystatus;
                                 if ($env{'user.adv'}) {                                  if ($env{'user.adv'}) { 
                                     my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};                                      my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};
                                     if ($disposition eq 'automatic') {                                      if ($disposition eq 'automatic') {
                                         $refused = '';                                          $refused = '';
                                     } elsif ($disposition eq '') {                                      } elsif ($disposition eq '') {
                                         $checkbystatus = 1;                                          $checkbystatus = 1;
                                     }                                      } 
                                 } else {                                  } else {
                                     $checkbystatus = 1;                                      $checkbystatus = 1;
                                 }                                  }
Line 8391  sub assignrole { Line 8378  sub assignrole {
                            $context);                             $context);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {          } elsif (($role eq 'ca') || ($role eq 'aa')) {
             &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                              $context);                               $context); 
         }          }
         if ($role eq 'cc') {          if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);              &autoupdate_coowners($url,$end,$start,$uname,$udom);
Line 8706  sub modifystudent { Line 8693  sub modifystudent {
     # student's environment      # student's environment
     $uid = undef if (!$forceid);      $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,      $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
  $gene,$usec,$end,$start,$type,$locktype,                                          $gene,$usec,$end,$start,$type,$locktype,
                                         $cid,$selfenroll,$context,$credits);                                          $cid,$selfenroll,$context,$credits);
     return $reply;      return $reply;
 }  }
Line 9188  sub files_not_in_path { Line 9175  sub files_not_in_path {
     return (@return_files);      return (@return_files);
 }  }
   
   #------------------------------Submitted/Handedback Portfolio Files Versioning
    
   sub portfiles_versioning {
       my ($symb,$domain,$stu_name,$portfiles,$versioned_portfiles) = @_;
       my $portfolio_root = '/userfiles/portfolio';
       return unless ((ref($portfiles) eq 'ARRAY') && (ref($versioned_portfiles) eq 'ARRAY'));
       foreach my $file (@{$portfiles}) {
           &unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
           my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
           my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file);
           my $getpropath = 1;
           my ($dir_list,$listerror) = &dirlist($portfolio_root.$directory,$domain,
                                                $stu_name,$getpropath);
           my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
           my $new_answer = 
               &version_selected_portfile($domain,$stu_name,$directory,$answer_file,$version);
           if ($new_answer ne 'problem getting file') {
               push(@{$versioned_portfiles}, $directory.$new_answer);
               &mark_as_readonly($domain,$stu_name,[$directory.$new_answer],
                                 [$symb,$env{'request.course.id'},'graded']);
           }
       }
   }
   
   sub get_next_version {
       my ($answer_name, $answer_ext, $dir_list) = @_;
       my $version;
       if (ref($dir_list) eq 'ARRAY') {
           foreach my $row (@{$dir_list}) {
               my ($file) = split(/\&/,$row,2);
               my ($file_name,$file_version,$file_ext) =
                   &file_name_version_ext($file);
               if (($file_name eq $answer_name) &&
                   ($file_ext eq $answer_ext)) {
                        # gets here if filename and extension match,
                        # regardless of version
                   if ($file_version ne '') {
                       # a versioned file is found  so save it for later
                       if ($file_version > $version) {
                           $version = $file_version;
                       }
                   }
               }
           }
       }
       $version ++;
       return($version);
   }
   
   sub version_selected_portfile {
       my ($domain,$stu_name,$directory,$file_name,$version) = @_;
       my ($answer_name,$answer_ver,$answer_ext) =
           &file_name_version_ext($file_name);
       my $new_answer;
       $env{'form.copy'} =
           &getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
       if($env{'form.copy'} eq '-1') {
           $new_answer = 'problem getting file';
       } else {
           $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
           my $copy_result = 
               &finishuserfileupload($stu_name,$domain,'copy',
                                     '/portfolio'.$directory.$new_answer);
       }
       undef($env{'form.copy'});
       return ($new_answer);
   }
   
   sub file_name_version_ext {
       my ($file)=@_;
       my @file_parts = split(/\./, $file);
       my ($name,$version,$ext);
       if (@file_parts > 1) {
           $ext=pop(@file_parts);
           if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
               $version=pop(@file_parts);
           }
           $name=join('.',@file_parts);
       } else {
           $name=join('.',@file_parts);
       }
       return($name,$version,$ext);
   }
   
 #----------------------------------------------Get portfolio file permissions  #----------------------------------------------Get portfolio file permissions
   
 sub get_portfile_permissions {  sub get_portfile_permissions {
Line 9332  sub modify_access_controls { Line 9403  sub modify_access_controls {
 }  }
   
 sub make_public_indefinitely {  sub make_public_indefinitely {
     my ($requrl) = @_;      my (@requrl) = @_;
       return &automated_portfile_access('public',\@requrl);
   }
   
   sub automated_portfile_access {
       my ($accesstype,$addsref,$delsref,$info) = @_;
       unless (($accesstype eq 'public') || ($accesstype eq 'ip')) {
           return 'invalid';
       }
       my %urls;
       if (ref($addsref) eq 'ARRAY') {
           foreach my $requrl (@{$addsref}) {
               if (&is_portfolio_url($requrl)) {
                   unless (exists($urls{$requrl})) {
                       $urls{$requrl} = 'add';
                   }
               }
           }
       }
       if (ref($delsref) eq 'ARRAY') {
           foreach my $requrl (@{$delsref}) { 
               if (&is_portfolio_url($requrl)) {
                   unless (exists($urls{$requrl})) {
                       $urls{$requrl} = 'delete'; 
                   }
               }
           }
       }
       unless (keys(%urls)) {
           return 'invalid';
       }
       my $ip;
       if ($accesstype eq 'ip') {
           if (ref($info) eq 'HASH') {
               if ($info->{'ip'} ne '') {
                   $ip = $info->{'ip'};
               }
           }
           if ($ip eq '') {
               return 'invalid';
           }
       }
       my $errors;
     my $now = time;      my $now = time;
     my $action = 'activate';      my %current_perms;
     my $aclnum = 0;      foreach my $requrl (sort(keys(%urls))) {
     if (&is_portfolio_url($requrl)) {          my $action;
           if ($urls{$requrl} eq 'add') {
               $action = 'activate';
           } else {
               $action = 'none';
           }
           my $aclnum = 0;
         my (undef,$udom,$unum,$file_name,$group) =          my (undef,$udom,$unum,$file_name,$group) =
             &parse_portfolio_url($requrl);              &parse_portfolio_url($requrl);
         my $current_perms = &get_portfile_permissions($udom,$unum);          unless (exists($current_perms{$unum.':'.$udom})) {
         my %access_controls = &get_access_controls($current_perms,              $current_perms{$unum.':'.$udom} = &get_portfile_permissions($udom,$unum);
           }
           my %access_controls = &get_access_controls($current_perms{$unum.':'.$udom},
                                                    $group,$file_name);                                                     $group,$file_name);
         foreach my $key (keys(%{$access_controls{$file_name}})) {          foreach my $key (keys(%{$access_controls{$file_name}})) {
             my ($num,$scope,$end,$start) =               my ($num,$scope,$end,$start) = 
                 ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);                  ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
             if ($scope eq 'public') {              if ($scope eq $accesstype) {
                 if ($start <= $now && $end == 0) {                  if (($start <= $now) && ($end == 0)) {
                     $action = 'none';                      if ($accesstype eq 'ip') {
                 } else {                          if (ref($access_controls{$file_name}{$key}) eq 'HASH') {
                               if (ref($access_controls{$file_name}{$key}{'ip'}) eq 'ARRAY') {
                                   if (grep(/^\Q$ip\E$/,@{$access_controls{$file_name}{$key}{'ip'}})) {
                                       if ($urls{$requrl} eq 'add') {
                                           $action = 'none';
                                           last;
                                       } else {
                                           $action = 'delete';
                                           $aclnum = $num;
                                           last;
                                       }
                                   }
                               }
                           }
                       } elsif ($accesstype eq 'public') {
                           if ($urls{$requrl} eq 'add') {
                               $action = 'none';
                               last;
                           } else {
                               $action = 'delete';
                               $aclnum = $num;
                               last;
                           }
                       }
                   } elsif ($accesstype eq 'public') {
                     $action = 'update';                      $action = 'update';
                     $aclnum = $num;                      $aclnum = $num;
                       last;
                 }                  }
                 last;  
             }              }
         }          }
         if ($action eq 'none') {          if ($action eq 'none') {
              return 'ok';              next;
         } else {          } else {
             my %changes;              my %changes;
             my $newend = 0;              my $newend = 0;
             my $newstart = $now;              my $newstart = $now;
             my $newkey = $aclnum.':public_'.$newend.'_'.$newstart;              my $newkey = $aclnum.':'.$accesstype.'_'.$newend.'_'.$newstart;
             $changes{$action}{$newkey} = {              $changes{$action}{$newkey} = {
                 type => 'public',                  type => $accesstype,
                 time => {                  time => {
                     start => $newstart,                      start => $newstart,
                     end   => $newend,                      end   => $newend,
                 },                  },
             };              };
               if ($accesstype eq 'ip') {
                   $changes{$action}{$newkey}{'ip'} = [$ip];
               }
             my ($outcome,$deloutcome,$new_values,$translation) =              my ($outcome,$deloutcome,$new_values,$translation) =
                 &modify_access_controls($file_name,\%changes,$udom,$unum);                  &modify_access_controls($file_name,\%changes,$udom,$unum);
             return $outcome;              unless ($outcome eq 'ok') {
                   $errors .= $outcome.' ';
               }
         }          }
       }
       if ($errors) {
           $errors =~ s/\s$//;
           return $errors;
     } else {      } else {
         return 'invalid';          return 'ok';
     }      }
 }  }
   
Line 9851  sub get_numsuppfiles { Line 10005  sub get_numsuppfiles {
         unless ($chome eq 'no_host') {          unless ($chome eq 'no_host') {
             ($suppcount,my $errors) = (0,0);              ($suppcount,my $errors) = (0,0);
             my $suppmap = 'supplemental.sequence';              my $suppmap = 'supplemental.sequence';
             ($suppcount,$errors) =              ($suppcount,$errors) = 
                 &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);                  &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
         }          }
         &do_cache_new('suppcount',$hashid,$suppcount,600);          &do_cache_new('suppcount',$hashid,$suppcount,600);
Line 10046  sub EXT { Line 10200  sub EXT {
             $courseid = $cid;              $courseid = $cid;
         }          }
  if (($symbparm && $courseid) &&    if (($symbparm && $courseid) && 
     (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid))) {      (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid)))  {
   
     #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;      #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
   
Line 10558  sub metadata { Line 10712  sub metadata {
   
  $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));
  &do_cache_new('meta',$uri,\%metaentry,$cachetime);   &do_cache_new('meta',$uri,\%metaentry,$cachetime);
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
Line 10834  sub symbverify { Line 10988  sub symbverify {
             $ids=$bighash{'ids_'.&clutter($thisurl)};              $ids=$bighash{'ids_'.&clutter($thisurl)};
         }          }
         unless ($ids) {          unless ($ids) {
             my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;              my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;  
             $ids=$bighash{$idkey};              $ids=$bighash{$idkey};
         }          }
         if ($ids) {          if ($ids) {
Line 10850  sub symbverify { Line 11004  sub symbverify {
                    if (ref($encstate)) {                     if (ref($encstate)) {
                        $$encstate = $bighash{'encrypted_'.$id};                         $$encstate = $bighash{'encrypted_'.$id};
                    }                     }
                    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')) {                         ($thisurl eq '/adm/navmaps')) {
                        $okay=1;         $okay=1;
                        last;                         last;
                    }     }
                }         }
            }     }
         }          }
  untie(%bighash);   untie(%bighash);
     }      }
Line 10930  sub deversion { Line 11084  sub deversion {
   
 sub symbread {  sub symbread {
     my ($thisfn,$donotrecurse)=@_;      my ($thisfn,$donotrecurse)=@_;
     my $cache_str;      my $cache_str='request.symbread.cached.'.$thisfn;
     if ($thisfn ne '') {      if (defined($env{$cache_str})) { return $env{$cache_str}; }
         $cache_str='request.symbread.cached.'.$thisfn;  
         if ($env{$cache_str} ne '') {  
             return $env{$cache_str};  
         }  
    } else {  
 # no filename provided? try from environment  # no filename provided? try from environment
       unless ($thisfn) {
         if ($env{'request.symb'}) {          if ($env{'request.symb'}) {
             return $env{$cache_str}=&symbclean($env{'request.symb'});      return $env{$cache_str}=&symbclean($env{'request.symb'});
         }   }
         $thisfn=$env{'request.filename'};   $thisfn=$env{'request.filename'};
     }      }
     if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }      if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
 # is that filename actually a symb? Verify, clean, and return  # is that filename actually a symb? Verify, clean, and return
Line 11169  sub rndseed { Line 11319  sub rndseed {
  $which =&get_rand_alg($courseid);   $which =&get_rand_alg($courseid);
     }      }
     if (defined(&getCODE())) {      if (defined(&getCODE())) {
   
  if ($which eq '64bit5') {   if ($which eq '64bit5') {
     return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);      return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
  } elsif ($which eq '64bit4') {   } elsif ($which eq '64bit4') {
Line 11354  sub rndseed_CODE_64bit5 { Line 11505  sub rndseed_CODE_64bit5 {
 sub setup_random_from_rndseed {  sub setup_random_from_rndseed {
     my ($rndseed)=@_;      my ($rndseed)=@_;
     if ($rndseed =~/([,:])/) {      if ($rndseed =~/([,:])/) {
  my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed));          my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed));
         if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) {          if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) {
             &Math::Random::random_set_seed_from_phrase($rndseed);              &Math::Random::random_set_seed_from_phrase($rndseed);
         } else {          } else {
Line 11887  sub get_dns { Line 12038  sub get_dns {
         delete($alldns{$dns});          delete($alldns{$dns});
  next if ($response->is_error());   next if ($response->is_error());
  my @content = split("\n",$response->content);   my @content = split("\n",$response->content);
         unless ($nocache) {   unless ($nocache) {
     &do_cache_new('dns',$url,\@content,30*24*60*60);      &do_cache_new('dns',$url,\@content,30*24*60*60);
         }   }
  &$func(\@content,$hashref);   &$func(\@content,$hashref);
  return;   return;
     }      }
Line 11905  sub get_dns { Line 12056  sub get_dns {
 # ------------------------------------------------------Get DNS checksums file  # ------------------------------------------------------Get DNS checksums file
 sub parse_dns_checksums_tab {  sub parse_dns_checksums_tab {
     my ($lines,$hashref) = @_;      my ($lines,$hashref) = @_;
     my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});      my $lonhost = $perlvar{'lonHostID'};
       my $machine_dom = &Apache::lonnet::host_domain($lonhost);
     my $loncaparev = &get_server_loncaparev($machine_dom);      my $loncaparev = &get_server_loncaparev($machine_dom);
       my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
       my $webconfdir = '/etc/httpd/conf';
       if ($distro =~ /^(ubuntu|debian)(\d+)$/) {
           $webconfdir = '/etc/apache2';
       } elsif ($distro =~ /^sles(\d+)$/) {
           if ($1 >= 10) {
               $webconfdir = '/etc/apache2';
           }
       } elsif ($distro =~ /^suse(\d+\.\d+)$/) {
           if ($1 >= 10.0) {
               $webconfdir = '/etc/apache2';
           }
       }
     my ($release,$timestamp) = split(/\-/,$loncaparev);      my ($release,$timestamp) = split(/\-/,$loncaparev);
     my (%chksum,%revnum);      my (%chksum,%revnum);
     if (ref($lines) eq 'ARRAY') {      if (ref($lines) eq 'ARRAY') {
         chomp(@{$lines});          chomp(@{$lines});
         my $version = shift(@{$lines});          my $version = shift(@{$lines});
         if ($version eq $release) {          if ($version eq $release) {  
             foreach my $line (@{$lines}) {              foreach my $line (@{$lines}) {
                 my ($file,$version,$shasum) = split(/,/,$line);                  my ($file,$version,$shasum) = split(/,/,$line);
                   if ($file =~ m{^/etc/httpd/conf}) {
                       if ($webconfdir eq '/etc/apache2') {
                           $file =~ s{^\Q/etc/httpd/conf/\E}{$webconfdir/};
                       }
                   }
                 $chksum{$file} = $shasum;                  $chksum{$file} = $shasum;
                 $revnum{$file} = $version;                  $revnum{$file} = $version;
             }              }
Line 12315  sub all_loncaparevs { Line 12485  sub all_loncaparevs {
     return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11);      return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11);
 }  }
   
 # ------------------------------------------------------- Read loncaparev table  # ---------------------------------------------------------- Read loncaparev table
 {  {
     sub load_loncaparevs {      sub load_loncaparevs { 
         if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {          if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
             if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {              if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
                 while (my $configline=<$config>) {                  while (my $configline=<$config>) {
Line 12331  sub all_loncaparevs { Line 12501  sub all_loncaparevs {
     }      }
 }  }
   
 # ----------------------------------------------------- Read serverhostID table  # ---------------------------------------------------------- Read serverhostID table
 {  {
     sub load_serverhomeIDs {      sub load_serverhomeIDs {
         if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {          if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
Line 12423  BEGIN { Line 12593  BEGIN {
     close($config);      close($config);
 }  }
   
 # --------------------------------------------------------- Read loncaparev table  # ---------------------------------------------------------- Read loncaparev table
   
 &load_loncaparevs();  &load_loncaparevs();
   
 # ------------------------------------------------------- Read serverhostID table  # ---------------------------------------------------------- Read serverhostID table
   
 &load_serverhomeIDs();  &load_serverhomeIDs();
   
Line 12631  were new keys. I.E. 1:foo will become 1: Line 12801  were new keys. I.E. 1:foo will become 1:
 Calling convention:  Calling convention:
   
  my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);   my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);
  &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname);   &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$laststore);
   
 For more detailed information, see lonnet specific documentation.  For more detailed information, see lonnet specific documentation.
   
Line 12825  provided for types, will default to retu Line 12995  provided for types, will default to retu
 =item *  =item *
   
 in_course($udom,$uname,$cdom,$cnum,$type,$hideprivileged) : determine if  in_course($udom,$uname,$cdom,$cnum,$type,$hideprivileged) : determine if
 user: $uname:$udom has a role in the course: $cdom_$cnum.  user: $uname:$udom has a role in the course: $cdom_$cnum. 
   
 Additional optional arguments are: $type (if role checking is to be restricted  Additional optional arguments are: $type (if role checking is to be restricted 
 to certain user status types -- previous (expired roles), active (currently  to certain user status types -- previous (expired roles), active (currently
 available roles) or future (roles available in the future), and  available roles) or future (roles available in the future), and
 $hideprivileged -- if true will not report course roles for users who  $hideprivileged -- if true will not report course roles for users who
Line 13064  values that are the resource value.  I b Line 13234  values that are the resource value.  I b
 versions are also returned.  versions are also returned.
   
 get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's  get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
 supplemental content area. This routine caches the number of files for  supplemental content area. This routine caches the number of files for 
 10 minutes.  10 minutes.
   
 =back  =back
Line 13177  and is a possible symb for the URL in $t Line 13347  and is a possible symb for the URL in $t
 resource that the user accessed using /enc/ returns a 1 on success, 0  resource that the user accessed using /enc/ returns a 1 on success, 0
 on failure, user must be in a course, as it assumes the existence of  on failure, user must be in a course, as it assumes the existence of
 the course initial hash, and uses $env('request.course.id'}.  The third  the course initial hash, and uses $env('request.course.id'}.  The third
 arg is an optional reference to a scalar.  If this arg is passed in the  arg is an optional reference to a scalar.  If this arg is passed in the 
 call to symbverify, it will be set to 1 if the symb has been set to be   call to symbverify, it will be set to 1 if the symb has been set to be 
 encrypted; otherwise it will be null.  encrypted; otherwise it will be null.  
   
 =item *  =item *
   
Line 13232  expirespread($uname,$udom,$stype,$usymb) Line 13402  expirespread($uname,$udom,$stype,$usymb)
 devalidate($symb) : devalidate temporary spreadsheet calculations,  devalidate($symb) : devalidate temporary spreadsheet calculations,
 forcing spreadsheet to reevaluate the resource scores next time.  forcing spreadsheet to reevaluate the resource scores next time.
   
 =item *  =item * 
   
 can_edit_resource($file,$cnum,$cdom,$resurl,$symb,$group) : determine if current user can edit a particular resource,  can_edit_resource($file,$cnum,$cdom,$resurl,$symb,$group) : determine if current user can edit a particular resource,
 when viewing in course context.  when viewing in course context.
   
  input: six args -- filename (decluttered), course number, course domain,   input: six args -- filename (decluttered), course number, course domain,
                     url, symb (if registered) and group (if this is a                      url, symb (if registered) and group (if this is a 
                     group item -- e.g., bulletin board, group page etc.).                      group item -- e.g., bulletin board, group page etc.).
   
  output: array of five scalars --   output: array of five scalars --
Line 13246  when viewing in course context. Line 13416  when viewing in course context.
          $home -- homeserver of resource (i.e., for author if published,           $home -- homeserver of resource (i.e., for author if published,
                                           or course if uploaded.).                                            or course if uploaded.).
          $switchserver --  1 if server switch will be needed.           $switchserver --  1 if server switch will be needed.
          $forceedit -- 1 if icon/link should be to go to edit mode           $forceedit -- 1 if icon/link should be to go to edit mode 
          $forceview -- 1 if icon/link should be to go to view mode           $forceview -- 1 if icon/link should be to go to view mode
   
 =item *  =item *
   
 is_course_upload($file,$cnum,$cdom)  is_course_upload($file,$cnum,$cdom)
   
 Used in course context to determine if current file was uploaded to  Used in course context to determine if current file was uploaded to 
 the course (i.e., would be found in /userfiles/docs on the course's  the course (i.e., would be found in /userfiles/docs on the course's 
 homeserver.  homeserver.
   
   input: 3 args -- filename (decluttered), course number and course domain.    input: 3 args -- filename (decluttered), course number and course domain.
Line 13268  homeserver. Line 13438  homeserver.
   
 =item *  =item *
   
 store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently  store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash
 for this url; hashref needs to be given and should be a \%hashname; the  permanently for this url; hashref needs to be given and should be a \%hashname;
 remaining args aren't required and if they aren't passed or are '' they will  the remaining args aren't required and if they aren't passed or are '' they will
 be derived from the env  be derived from the env (with the exception of $laststore, which is an 
   optional arg used when a user's submission is stored in grading).
   $laststore is $version=$timestamp, where $version is the most recent version
   number retrieved for the corresponding $symb in the $namespace db file, and
   $timestamp is the timestamp for that transaction (UNIX time).
   $laststore is currently only passed when cstore() is called by 
   structuretags::finalize_storage().
   
 =item *  =item *
   
 cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but  cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store
 uses critical subroutine  but uses critical subroutine
   
 =item *  =item *
   
Line 13299  $range should be either an integer '100' Line 13475  $range should be either an integer '100'
   
 =item *  =item *
   
 putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :  putstore($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog) :
 replaces a &store() version of data with a replacement set of data  replaces a &store() version of data with a replacement set of data
 for a particular resource in a namespace passed in the $storehash hash   for a particular resource in a namespace passed in the $storehash hash 
 reference  reference. If $tolog is true, the transaction is logged in the courselog
   with an action=PUTSTORE.
   
 =item *  =item *
   
Line 13412  server ($udom and $uhome are optional) Line 13589  server ($udom and $uhome are optional)
   
 =item *   =item * 
   
 get_domain_defaults($target_domain,$ignore_cache) : returns hash with defaults  get_domain_defaults($target_domain,$ignore_cache) : returns hash with defaults 
 for: authentication, language, quotas, timezone, date locale, and portal URL in  for: authentication, language, quotas, timezone, date locale, and portal URL in
 the target domain.  the target domain.
   
Line 13467  for course's uploaded content. Line 13644  for course's uploaded content.
 =over  =over
   
 =item  =item
 canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota, communityquota, textbookquota  canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota, 
   communityquota, textbookquota
   
 =back  =back
   
Line 13477  on your servers. Line 13655  on your servers.
   
 =over  =over
   
 =item  =item 
 remotesessions, hostedsessions  remotesessions, hostedsessions
   
 =back  =back
Line 13485  remotesessions, hostedsessions Line 13663  remotesessions, hostedsessions
 =back  =back
   
 In cases where a domain coordinator has never used the "Set Domain Configuration"  In cases where a domain coordinator has never used the "Set Domain Configuration"
 utility to create a configuration.db file on a domain's primary library server  utility to create a configuration.db file on a domain's primary library server 
 only the following domain defaults: auth_def, auth_arg_def, lang_def  only the following domain defaults: auth_def, auth_arg_def, lang_def
 -- corresponding values are authentication type (internal, krb4, krb5,  -- corresponding values are authentication type (internal, krb4, krb5,
 or localauth), initial password or a kerberos realm, language (e.g., en-us) --  or localauth), initial password or a kerberos realm, language (e.g., en-us) -- 
 will be available. Values are retrieved from cache (if current), unless the  will be available. Values are retrieved from cache (if current), unless the
 optional $ignore_cache arg is true, or from domain's configuration.db (if available),  optional $ignore_cache arg is true, or from domain's configuration.db (if available),
 or lastly from values in lonTabs/dns_domain,tab, or lonTabs/domain.tab.  or lastly from values in lonTabs/dns_domain,tab, or lonTabs/domain.tab.
Line 13916  Returns: Line 14094  Returns:
   
 get_timebased_id():  get_timebased_id():
   
 Attempts to get a unique timestamp-based suffix for use with items added to a  Attempts to get a unique timestamp-based suffix for use with items added to a 
 course via the Course Editor (e.g., folders, composite pages,  course via the Course Editor (e.g., folders, composite pages, 
 group bulletin boards).  group bulletin boards).
   
 Args: (first three required; six others optional)  Args: (first three required; six others optional)
Line 13928  Args: (first three required; six others Line 14106  Args: (first three required; six others
 2. keyid (alphanumeric): name of temporary locking key in hash,  2. keyid (alphanumeric): name of temporary locking key in hash,
    e.g., num, boardids     e.g., num, boardids
   
 3. namespace: name of gdbm file used to store suffixes already assigned;  3. namespace: name of gdbm file used to store suffixes already assigned;  
    file will be named nohist_namespace.db     file will be named nohist_namespace.db
   
 4. cdom: domain of course; default is current course domain from %env  4. cdom: domain of course; default is current course domain from %env
   
 5. cnum: course number; default is current course number from %env  5. cnum: course number; default is current course number from %env
   
 6. idtype: set to concat if an additional digit is to be appended to the  6. idtype: set to concat if an additional digit is to be appended to the 
    unix timestamp to form the suffix, if the plain timestamp is already     unix timestamp to form the suffix, if the plain timestamp is already
    in use.  Default is to not do this, but simply increment the unix     in use.  Default is to not do this, but simply increment the unix 
    timestamp by 1 until a unique key is obtained.     timestamp by 1 until a unique key is obtained.
   
 7. who: holder of locking key; defaults to user:domain for user.  7. who: holder of locking key; defaults to user:domain for user.
   
 8. locktries: number of attempts to obtain a lock (sleep of 1s before  8. locktries: number of attempts to obtain a lock (sleep of 1s before 
    retrying); default is 3.     retrying); default is 3.
   
 9. maxtries: number of attempts to obtain a unique suffix; default is 20.  9. maxtries: number of attempts to obtain a unique suffix; default is 20.  
   
 Returns:  Returns:
   
Removed from v.1.1172.2.52  
changed lines
  Added in v.1.1278

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