[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.1261

version 1.1172.2.52, 2014/06/25 18:44:10 version 1.1261, 2014/05/29 12:45:05
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 1297  sub check_loadbalancing { Line 1302  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 1361  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 1417  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 1607  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 2068  sub get_domain_defaults { Line 2073  sub get_domain_defaults {
         }          }
     }      }
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {      if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
           $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
         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 2118  sub get_domain_defaults { Line 2124  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 2722  sub ssi { Line 2728  sub ssi {
   
     $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 2766  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 2774  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 2868  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 2899  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 2946  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 2973  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 3479  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 4150  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 4258  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 4282  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 4481  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 5151  sub privileged { Line 5074  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 5178  sub privileged { Line 5101  sub privileged {
         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 5139  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 5687  sub unserialize { Line 5610  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 5705  sub dump { Line 5629  sub dump {
     my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
   
     my $reply;      my $reply;
     if (grep { $_ eq $uhome } &current_machine_ids()) {      if (grep { $_ eq $uhome } current_machine_ids()) {
         # user is hosted on this machine          # user is hosted on this machine
         $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,          $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
                     $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});                      $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
         return %{&unserialize($reply, $escapedkeys)};          return %{unserialize($reply, $escapedkeys)};
     }      }
     if ($regexp) {      if ($regexp) {
  $regexp=&escape($regexp);   $regexp=&escape($regexp);
Line 5722  sub dump { Line 5646  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 5691  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 6014  sub tmpdel { Line 5939  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 5959  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 6385  sub usertools_access { Line 6310  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 6876  sub allowed { Line 6801  sub allowed {
  && &is_portfolio_url($uri)) {   && &is_portfolio_url($uri)) {
  $thisallowed = &portfolio_access($uri);   $thisallowed = &portfolio_access($uri);
     }      }
       
 # 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 7388  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 7935  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 8216  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 8224  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 8317  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 8632  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 9851  sub get_numsuppfiles { Line 9777  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 9972  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 10834  sub symbverify { Line 10760  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 10776  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 10936  sub symbread { Line 10862  sub symbread {
         if ($env{$cache_str} ne '') {          if ($env{$cache_str} ne '') {
             return $env{$cache_str};              return $env{$cache_str};
         }          }
    } else {      } else {
 # no filename provided? try from environment  # no filename provided? try from environment
         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 11095  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 11281  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)=split(/[,:]/,$rndseed);
         if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) {   &Math::Random::random_set_seed(abs($num1),abs($num2));
             &Math::Random::random_set_seed_from_phrase($rndseed);  
         } else {  
             &Math::Random::random_set_seed($num1,$num2);  
         }  
     } else {      } else {
  &Math::Random::random_set_seed_from_phrase($rndseed);   &Math::Random::random_set_seed_from_phrase($rndseed);
     }      }
Line 11879  sub get_dns { Line 11802  sub get_dns {
  $alldns{$host} = $protocol;   $alldns{$host} = $protocol;
     }      }
     while (%alldns) {      while (%alldns) {
  my ($dns) = sort { $b cmp $a } keys(%alldns);   my ($dns) = keys(%alldns);
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
         $ua->timeout(30);          $ua->timeout(30);
  my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");   my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
Line 11887  sub get_dns { Line 11810  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 11912  sub parse_dns_checksums_tab { Line 11835  sub parse_dns_checksums_tab {
     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);
                 $chksum{$file} = $shasum;                  $chksum{$file} = $shasum;
Line 12315  sub all_loncaparevs { Line 12238  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 12254  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 12346  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 12825  provided for types, will default to retu Line 12748  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 12987  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 13100  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 13155  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 13169  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 13412  server ($udom and $uhome are optional) Line 13335  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 13390  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 13401  on your servers.
   
 =over  =over
   
 =item  =item 
 remotesessions, hostedsessions  remotesessions, hostedsessions
   
 =back  =back
Line 13485  remotesessions, hostedsessions Line 13409  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 13840  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 13852  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.1261

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