[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.865 and 1.910

version 1.865, 2007/04/04 18:01:11 version 1.910, 2007/09/05 17:37:51
Line 31  package Apache::lonnet; Line 31  package Apache::lonnet;
   
 use strict;  use strict;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  
 use HTTP::Date;  use HTTP::Date;
 # use Date::Parse;  # use Date::Parse;
 use vars   use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
 qw(%perlvar %badServerCache %spareid               $_64bit %env);
    %pr %prp $memcache %packagetab   
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount   my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
    $tmpdir $_64bit %env);      %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
       %courseownerbuf, %coursetypebuf);
   
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use HTML::LCParser;  use HTML::LCParser;
 use HTML::Parser;  
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);  use Storable qw(thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes qw( gettimeofday tv_interval );
 use Cache::Memcached;  use Cache::Memcached;
 use Digest::MD5;  use Digest::MD5;
Line 150  sub create_connection { Line 149  sub create_connection {
      Type    => SOCK_STREAM,       Type    => SOCK_STREAM,
      Timeout => 10);       Timeout => 10);
     return 0 if (!$client);      return 0 if (!$client);
     print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n");      print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
     my $result = <$client>;      my $result = <$client>;
     chomp($result);      chomp($result);
     return 1 if ($result eq 'done');      return 1 if ($result eq 'done');
Line 182  sub subreply { Line 181  sub subreply {
  $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",   $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
       Type    => SOCK_STREAM,        Type    => SOCK_STREAM,
       Timeout => 10);        Timeout => 10);
  if($client) {   if ($client) {
     last; # Connected!      last; # Connected!
  } else {   } else {
     &create_connection(&hostname($server),$server);      &create_connection(&hostname($server),$server);
Line 215  sub reply { Line 214  sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
       my ($lonid) = @_;
       my $hostname = &hostname($lonid);
       if ($lonid) {
    my $peerfile="$perlvar{'lonSockDir'}/$hostname";
    if ($hostname && -e $peerfile) {
       &logthis("Trying to reconnect lonc for $lonid ($hostname)");
       my $client=IO::Socket::UNIX->new(Peer    => $peerfile,
        Type    => SOCK_STREAM,
        Timeout => 10);
       if ($client) {
    print $client ("reset_retries\n");
    my $answer=<$client>;
    #reset just this one.
       }
    }
    return;
       }
   
     &logthis("Trying to reconnect lonc");      &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {      if (open(my $fh,"<$loncfile")) {
Line 745  sub get_dom { Line 762  sub get_dom {
         if (defined(&domain($udom,'primary'))) {          if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');              $uhome=&domain($udom,'primary');
         } else {          } else {
             $uhome eq '';              undef($uhome);
         }          }
     } else {      } else {
         if (!$uhome) {          if (!$uhome) {
Line 756  sub get_dom { Line 773  sub get_dom {
     }      }
     if ($udom && $uhome && ($uhome ne 'no_host')) {      if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);          my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
           my %returnhash;
           if ($rep eq '' || $rep =~ /^error: 2 /) {
               return %returnhash;
           }
         my @pairs=split(/\&/,$rep);          my @pairs=split(/\&/,$rep);
         if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {          if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
             return @pairs;              return @pairs;
         }          }
         my %returnhash=();  
         my $i=0;          my $i=0;
         foreach my $item (@$storearr) {          foreach my $item (@$storearr) {
             $returnhash{$item}=&thaw_unescape($pairs[$i]);              $returnhash{$item}=&thaw_unescape($pairs[$i]);
Line 768  sub get_dom { Line 788  sub get_dom {
         }          }
         return %returnhash;          return %returnhash;
     } else {      } else {
         &logthis("get_dom failed - no homeserver and/or domain");          &logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)");
     }      }
 }  }
   
Line 781  sub put_dom { Line 801  sub put_dom {
         if (defined(&domain($udom,'primary'))) {          if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');              $uhome=&domain($udom,'primary');
         } else {          } else {
             $uhome eq '';              undef($uhome);
         }          }
     } else {      } else {
         if (!$uhome) {          if (!$uhome) {
Line 826  sub retrieve_inst_usertypes { Line 846  sub retrieve_inst_usertypes {
     return (\%returnhash,\@order);      return (\%returnhash,\@order);
 }  }
   
   sub is_domainimage {
       my ($url) = @_;
       if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+-) {
           if (&domain($1) ne '') {
               return '1';
           }
       }
       return;
   }
   
   sub inst_directory_query {
       my ($srch) = @_;
       my $udom = $srch->{'srchdomain'};
       my %results;
       my $homeserver = &domain($udom,'primary');
       my $outcome;
       if ($homeserver ne '') {
    my $queryid=&reply("querysend:instdirsearch:".
      &escape($srch->{'srchby'}).':'.
      &escape($srch->{'srchterm'}).':'.
      &escape($srch->{'srchtype'}),$homeserver);
    my $host=&hostname($homeserver);
    if ($queryid !~/^\Q$host\E\_/) {
       &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
       return;
    }
    my $response = &get_query_reply($queryid);
    my $maxtries = 5;
    my $tries = 1;
    while (($response=~/^timeout/) && ($tries < $maxtries)) {
       $response = &get_query_reply($queryid);
       $tries ++;
    }
   
           if (!&error($response) && $response ne 'refused') {
               if ($response eq 'unavailable') {
                   $outcome = $response;
               } else {
                   $outcome = 'ok';
                   my @matches = split(/\n/,$response);
                   foreach my $match (@matches) {
                       my ($key,$value) = split(/=/,$match);
                       $results{&unescape($key).':'.$udom} = &thaw_unescape($value);
                   }
               }
           }
       }
       return ($outcome,%results);
   }
   
   sub usersearch {
       my ($srch) = @_;
       my $dom = $srch->{'srchdomain'};
       my %results;
       my %libserv = &all_library();
       my $query = 'usersearch';
       foreach my $tryserver (keys(%libserv)) {
           if (&host_domain($tryserver) eq $dom) {
               my $host=&hostname($tryserver);
               my $queryid=
                   &reply("querysend:".&escape($query).':'.&escape($dom).':'.
                          &escape($srch->{'srchby'}).'%%'.
                          &escape($srch->{'srchtype'}).':'.
                          &escape($srch->{'srchterm'}),$tryserver);
               if ($queryid !~/^\Q$host\E\_/) {
                   &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);
                   next;
               }
               my $reply = &get_query_reply($queryid);
               my $maxtries = 1;
               my $tries = 1;
               while (($reply=~/^timeout/) && ($tries < $maxtries)) {
                   $reply = &get_query_reply($queryid);
                   $tries ++;
               }
               if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
                   &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
               } else {
                   my @matches = split(/&/,$reply);
                   foreach my $match (@matches) {
                       my @items = split(/:/,$match);
                       my ($uname,$udom,%userhash);
                       foreach my $entry (@items) {
                           my ($key,$value) = split(/=/,$entry);
                           $key = &unescape($key);
                           $value = &unescape($value);
                           $userhash{$key} = $value;
                           if ($key eq 'username') {
                               $uname = $value;
                           } elsif ($key eq 'domain') {
                               $udom = $value;
                           } 
                       }
                       $results{$uname.':'.$udom} = \%userhash;
                   }
               }
           }
       }
       return %results;
   }
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 1052  my $kicks=0; Line 1173  my $kicks=0;
 my $hits=0;  my $hits=0;
 sub make_key {  sub make_key {
     my ($name,$id) = @_;      my ($name,$id) = @_;
     if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }      if (length($id) > 65 
    && length(&escape($id)) > 200) {
    $id=length($id).':'.&Digest::MD5::md5_hex($id);
       }
     return &escape($name.':'.$id);      return &escape($name.':'.$id);
 }  }
   
Line 1099  sub do_cache_new { Line 1223  sub do_cache_new {
  $time=600;   $time=600;
     }      }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }      if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     $memcache->set($id,$setvalue,$time);      my $result = $memcache->set($id,$setvalue,$time);
       if (! $result) {
    &logthis("caching of id -> $id  failed");
    $memcache->disconnect_all();
       }
     # need to make a copy of $value      # need to make a copy of $value
     #&make_room($id,$value,$debug);      #&make_room($id,$value,$debug);
     return $value;      return $value;
Line 1361  sub ssi { Line 1489  sub ssi {
     my $request;      my $request;
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
       &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 { &escape($_).'='.&escape($form{$_}) } keys %form));
Line 1722  sub extract_embedded_items { Line 1850  sub extract_embedded_items {
     while (my $t=$p->get_token()) {      while (my $t=$p->get_token()) {
  if ($t->[0] eq 'S') {   if ($t->[0] eq 'S') {
     my ($tagname, $attr) = ($t->[1],$t->[2]);      my ($tagname, $attr) = ($t->[1],$t->[2]);
     push (@state, $tagname);      push(@state, $tagname);
             if (lc($tagname) eq 'allow') {              if (lc($tagname) eq 'allow') {
                 &add_filetype($allfiles,$attr->{'src'},'src');                  &add_filetype($allfiles,$attr->{'src'},'src');
             }              }
     if (lc($tagname) eq 'img') {      if (lc($tagname) eq 'img') {
  &add_filetype($allfiles,$attr->{'src'},'src');   &add_filetype($allfiles,$attr->{'src'},'src');
     }      }
       if (lc($tagname) eq 'a') {
    &add_filetype($allfiles,$attr->{'href'},'href');
       }
             if (lc($tagname) eq 'script') {              if (lc($tagname) eq 'script') {
                 if ($attr->{'archive'} =~ /\.jar$/i) {                  if ($attr->{'archive'} =~ /\.jar$/i) {
                     &add_filetype($allfiles,$attr->{'archive'},'archive');                      &add_filetype($allfiles,$attr->{'archive'},'archive');
Line 1970  sub flushcourselogs { Line 2101  sub flushcourselogs {
 #  #
     my %domrolebuffer = ();      my %domrolebuffer = ();
     foreach my $entry (keys %domainrolehash) {      foreach my $entry (keys %domainrolehash) {
         my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;          my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
         if ($domrolebuffer{$rudom}) {          if ($domrolebuffer{$rudom}) {
             $domrolebuffer{$rudom}.='&'.&escape($entry).              $domrolebuffer{$rudom}.='&'.&escape($entry).
                       '='.&escape($domainrolehash{$entry});                        '='.&escape($domainrolehash{$entry});
Line 2075  sub userrolelog { Line 2206  sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
     }      }
       if (($env{'request.role'} =~ /dc\./) &&
    (($trole=~/^au/) || ($trole=~/^in/) ||
    ($trole=~/^cc/) || ($trole=~/^ep/) ||
    ($trole=~/^cr/) || ($trole=~/^ta/))) {
          $userrolehash
            {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                       =$tend.':'.$tstart;
       }
     if (($trole=~/^dc/) || ($trole=~/^ad/) ||      if (($trole=~/^dc/) || ($trole=~/^ad/) ||
         ($trole=~/^li/) || ($trole=~/^li/) ||          ($trole=~/^li/) || ($trole=~/^li/) ||
         ($trole=~/^au/) || ($trole=~/^dg/) ||          ($trole=~/^au/) || ($trole=~/^dg/) ||
Line 2133  sub get_my_roles { Line 2272  sub get_my_roles {
     my %returnhash=();      my %returnhash=();
     my $now=time;      my $now=time;
     foreach my $entry (keys(%dumphash)) {      foreach my $entry (keys(%dumphash)) {
  my ($tend,$tstart)=split(/\:/,$dumphash{$entry});          my ($role,$tend,$tstart);
           if ($context eq 'userroles') {
       ($role,$tend,$tstart)=split(/_/,$dumphash{$entry});
           } else {
               ($tend,$tstart)=split(/\:/,$dumphash{$entry});
           }
         if (($tstart) && ($tstart<0)) { next; }          if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';          my $status = 'active';
         if (($tend) && ($tend<$now)) {          if (($tend) && ($tend<$now)) {
Line 2151  sub get_my_roles { Line 2295  sub get_my_roles {
                 next;                  next;
             }              }
         }          }
         my ($role,$username,$domain,$section)=split(/\:/,$entry);          my ($rolecode,$username,$domain,$section,$area);
           if ($context eq 'userroles') {
               ($area,$rolecode) = split(/_/,$entry);
               (undef,$domain,$username,$section) = split(/\//,$area);
           } else {
               ($role,$username,$domain,$section) = split(/\:/,$entry);
           }
         if (ref($roledoms) eq 'ARRAY') {          if (ref($roledoms) eq 'ARRAY') {
             if (!grep(/^\Q$domain\E$/,@{$roledoms})) {              if (!grep(/^\Q$domain\E$/,@{$roledoms})) {
                 next;                  next;
Line 2161  sub get_my_roles { Line 2311  sub get_my_roles {
             if (!grep(/^\Q$role\E$/,@{$roles})) {              if (!grep(/^\Q$role\E$/,@{$roles})) {
                 next;                  next;
             }              }
         }           }
  $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;   $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
     }      }
     return %returnhash;      return %returnhash;
Line 3105  sub set_userprivs { Line 3255  sub set_userprivs {
     if (keys(%{$allgroups}) > 0) {      if (keys(%{$allgroups}) > 0) {
         foreach my $role (keys %{$allroles}) {          foreach my $role (keys %{$allroles}) {
             my ($trole,$area,$sec,$extendedarea);              my ($trole,$area,$sec,$extendedarea);
             if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) {              if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
                 $trole = $1;                  $trole = $1;
                 $area = $2;                  $area = $2;
                 $sec = $3;                  $sec = $3;
Line 3755  sub customaccess { Line 3905  sub customaccess {
     $ucrs = &LONCAPA::clean_username($ucrs);      $ucrs = &LONCAPA::clean_username($ucrs);
     my $access=0;      my $access=0;
     foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {      foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
  my ($effect,$realm,$role)=split(/\:/,$right);   my ($effect,$realm,$role,$type)=split(/\:/,$right);
         if ($role) {   if ($type eq 'user') {
    if ($role ne $urole) { next; }      foreach my $scope (split(/\s*\,\s*/,$realm)) {
         }   my ($tdom,$tuname)=split(m{/},$scope);
         foreach my $scope (split(/\s*\,\s*/,$realm)) {   if ($tdom) {
             my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);      if ($tdom ne $env{'user.domain'}) { next; }
             if ($tdom) {   }
  if ($tdom ne $udom) { next; }   if ($tuname) {
             }      if ($tuname ne $env{'user.name'}) { next; }
             if ($tcrs) {   }
  if ($tcrs ne $ucrs) { next; }   $access=($effect eq 'allow');
             }   last;
             if ($tsec) {      }
  if ($tsec ne $usec) { next; }   } else {
             }      if ($role) {
             $access=($effect eq 'allow');   if ($role ne $urole) { next; }
             last;      }
         }      foreach my $scope (split(/\s*\,\s*/,$realm)) {
  if ($realm eq '' && $role eq '') {   my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
             $access=($effect eq 'allow');   if ($tdom) {
       if ($tdom ne $udom) { next; }
    }
    if ($tcrs) {
       if ($tcrs ne $ucrs) { next; }
    }
    if ($tsec) {
       if ($tsec ne $usec) { next; }
    }
    $access=($effect eq 'allow');
    last;
       }
       if ($realm eq '' && $role eq '') {
    $access=($effect eq 'allow');
       }
  }   }
     }      }
     return $access;      return $access;
Line 4303  sub update_portfolio_table { Line 4467  sub update_portfolio_table {
     return $reply;      return $reply;
 }  }
   
   # -------------------------- Update MySQL allusers table
   
   sub update_allusers_table {
       my ($uname,$udom,$names) = @_;
       my $homeserver = &homeserver($uname,$udom);
       my $queryid=
           &reply('querysend:allusers:'.&escape($uname).':'.&escape($udom).':'.
                  'lastname='.&escape($names->{'lastname'}).'%%'.
                  'firstname='.&escape($names->{'firstname'}).'%%'.
                  'middlename='.&escape($names->{'middlename'}).'%%'.
                  'generation='.&escape($names->{'generation'}).'%%'.
                  'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
                  'id='.&escape($names->{'id'}),$homeserver);
       my $reply = &get_query_reply($queryid);
       return $reply;
   }
   
 # ------- Request retrieval of institutional classlists for course(s)  # ------- Request retrieval of institutional classlists for course(s)
   
 sub fetch_enrollment_query {  sub fetch_enrollment_query {
Line 4337  sub fetch_enrollment_query { Line 4518  sub fetch_enrollment_query {
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {      if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);          &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {      } else {
         my @responses = split/:/,$reply;          my @responses = split(/:/,$reply);
         if ($homeserver eq $perlvar{'lonHostID'}) {          if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach my $line (@responses) {              foreach my $line (@responses) {
                 my ($key,$value) = split(/=/,$line,2);                  my ($key,$value) = split(/=/,$line,2);
Line 4380  sub get_query_reply { Line 4561  sub get_query_reply {
  sleep 2;   sleep 2;
         if (-e $replyfile.'.end') {          if (-e $replyfile.'.end') {
     if (open(my $fh,$replyfile)) {      if (open(my $fh,$replyfile)) {
                $reply.=<$fh>;   $reply = join('',<$fh>);
                close($fh);   close($fh);
    } else { return 'error: reply_file_error'; }     } else { return 'error: reply_file_error'; }
            return &unescape($reply);             return &unescape($reply);
  }   }
Line 4426  sub userlog_query { Line 4607  sub userlog_query {
   
 sub auto_run {  sub auto_run {
     my ($cnum,$cdom) = @_;      my ($cnum,$cdom) = @_;
     my $homeserver = &homeserver($cnum,$cdom);      my $response = 0;
     my $response = &reply('autorun:'.$cdom,$homeserver);      my $settings;
       my %domconfig = &get_dom('configuration',['autoenroll'],$cdom);
       if (ref($domconfig{'autoenroll'}) eq 'HASH') {
           $settings = $domconfig{'autoenroll'};
           if ($settings->{'run'} eq '1') {
               $response = 1;
           }
       } else {
           my $homeserver = &homeserver($cnum,$cdom);
           $response = &reply('autorun:'.$cdom,$homeserver);
       }
     return $response;      return $response;
 }  }
   
Line 4437  sub auto_get_sections { Line 4628  sub auto_get_sections {
     my @secs = ();      my @secs = ();
     my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));      my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {      unless ($response eq 'refused') {
         @secs = split/:/,$response;          @secs = split(/:/,$response);
     }      }
     return @secs;      return @secs;
 }  }
Line 4457  sub auto_validate_courseID { Line 4648  sub auto_validate_courseID {
 }  }
   
 sub auto_create_password {  sub auto_create_password {
     my ($cnum,$cdom,$authparam) = @_;      my ($cnum,$cdom,$authparam,$udom) = @_;
     my $homeserver = &homeserver($cnum,$cdom);       my ($homeserver,$response);
     my $create_passwd = 0;      my $create_passwd = 0;
     my $authchk = '';      my $authchk = '';
     my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));      if ($udom =~ /^$match_domain$/) {
     if ($response eq 'refused') {          $homeserver = &domain($udom,'primary');
         $authchk = 'refused';      }
       if ($homeserver eq '') {
           if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
               $homeserver = &homeserver($cnum,$cdom);
           }
       }
       if ($homeserver eq '') {
           $authchk = 'nodomain';
     } else {      } else {
         ($authparam,$create_passwd,$authchk) = split/:/,$response;          $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
           if ($response eq 'refused') {
               $authchk = 'refused';
           } else {
               ($authparam,$create_passwd,$authchk) = split(/:/,$response);
           }
     }      }
     return ($authparam,$create_passwd,$authchk);      return ($authparam,$create_passwd,$authchk);
 }  }
Line 4572  sub auto_instcode_format { Line 4775  sub auto_instcode_format {
         $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);          $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {          if ($response !~ /(con_lost|error|no_such_host|refused)/) {
             my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) =               my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = 
  split/:/,$response;   split(/:/,$response);
             %{$codes} = (%{$codes},&str2hash($codes_str));              %{$codes} = (%{$codes},&str2hash($codes_str));
             push(@{$codetitles},&str2array($codetitles_str));              push(@{$codetitles},&str2array($codetitles_str));
             %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));              %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));
Line 4952  sub modifyuser { Line 5155  sub modifyuser {
     }      }
 # -------------------------------------------------------------- Add names, etc  # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',      my @tmp=&get('environment',
    ['firstname','middlename','lastname','generation'],     ['firstname','middlename','lastname','generation','id',
                       'permanentemail'],
    $udom,$uname);     $udom,$uname);
     my %names;      my %names;
     if ($tmp[0] =~ m/^error:.*/) {       if ($tmp[0] =~ m/^error:.*/) { 
Line 4974  sub modifyuser { Line 5178  sub modifyuser {
    $names{'critnotification'} = $email;     $names{'critnotification'} = $email;
    $names{'permanentemail'} = $email; }     $names{'permanentemail'} = $email; }
     }      }
       if ($uid) { $names{'id'}  = $uid; }
     my $reply = &put('environment', \%names, $udom,$uname);      my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }      if ($reply ne 'ok') { return 'error: '.$reply; }
       my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);      &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
Line 5270  sub save_selected_files { Line 5476  sub save_selected_files {
     my ($user, $path, @files) = @_;      my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);      my @other_files = &files_not_in_path($user, $path);
     open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);      open (OUT, '>'.$tmpdir.$filename);
     foreach my $file (@files) {      foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");          print (OUT $env{'form.currentpath'}.$file."\n");
     }      }
Line 5862  sub devalidatecourseresdata { Line 6068  sub devalidatecourseresdata {
   
   
 # --------------------------------------------------- Course Resourcedata Query  # --------------------------------------------------- Course Resourcedata Query
   #
   #  Parameters:
   #      $coursenum    - Number of the course.
   #      $coursedomain - Domain at which the course was created.
   #  Returns:
   #     A hash of the course parameters along (I think) with timestamps
   #     and version info.
   
 sub get_courseresdata {  sub get_courseresdata {
     my ($coursenum,$coursedomain)=@_;      my ($coursenum,$coursedomain)=@_;
Line 5920  sub get_userresdata { Line 6133  sub get_userresdata {
     }      }
     return $tmp;      return $tmp;
 }  }
   #----------------------------------------------- resdata - return resource data
   #  Purpose:
   #    Return resource data for either users or for a course.
   #  Parameters:
   #     $name      - Course/user name.
   #     $domain    - Name of the domain the user/course is registered on.
   #     $type      - Type of thing $name is (must be 'course' or 'user'
   #     @which     - Array of names of resources desired.
   #  Returns:
   #     The value of the first reasource in @which that is found in the
   #     resource hash.
   #  Exceptional Conditions:
   #     If the $type passed in is not valid (not the string 'course' or 
   #     'user', an undefined  reference is returned.
   #     If none of the resources are found, an undef is returned
 sub resdata {  sub resdata {
     my ($name,$domain,$type,@which)=@_;      my ($name,$domain,$type,@which)=@_;
     my $result;      my $result;
Line 6098  sub EXT { Line 6325  sub EXT {
     my ($map) = &decode_symb($symbparm);      my ($map) = &decode_symb($symbparm);
     return &symbread($map);      return &symbread($map);
  }   }
    if ($space eq 'filename') {
       if ($symbparm) {
    return &clutter((&decode_symb($symbparm))[2]);
       }
       return &hreflocation('',$env{'request.filename'});
    }
   
  my ($section, $group, @groups);   my ($section, $group, @groups);
  my ($courselevelm,$courselevel);   my ($courselevelm,$courselevel);
Line 6267  sub packages_tab_default { Line 6500  sub packages_tab_default {
     $do_default=1;      $do_default=1;
  } elsif ($pack_type eq 'extension') {   } elsif ($pack_type eq 'extension') {
     push(@extension,[$package,$pack_type,$pack_part]);      push(@extension,[$package,$pack_type,$pack_part]);
  } elsif ($pack_part eq $part) {   } elsif ($pack_part eq $part || $pack_type eq 'part') {
     # only look at packages defaults for packages that this id is      # only look at packages defaults for packages that this id is
     push(@specifics,[$package,$pack_type,$pack_part]);      push(@specifics,[$package,$pack_type,$pack_part]);
  }   }
Line 6471  sub metadata { Line 6704  sub metadata {
  # only ws inside the tag, and not in default, so use default   # only ws inside the tag, and not in default, so use default
  # as value   # as value
     $metaentry{':'.$unikey}=$default;      $metaentry{':'.$unikey}=$default;
  } else {   } elsif ( $internaltext =~ /\S/ ) {
   # either something interesting inside the tag or default    # something interesting inside the tag
                   # uninteresting  
     $metaentry{':'.$unikey}=$internaltext;      $metaentry{':'.$unikey}=$internaltext;
    } else {
     # no interesting values, don't set a default
  }   }
 # end of not-a-package not-a-library import  # end of not-a-package not-a-library import
     }      }
Line 6484  sub metadata { Line 6718  sub metadata {
     }      }
  }   }
  my ($extension) = ($uri =~ /\.(\w+)$/);   my ($extension) = ($uri =~ /\.(\w+)$/);
    $extension = lc($extension);
    if ($extension eq 'htm') { $extension='html'; }
   
  foreach my $key (keys(%packagetab)) {   foreach my $key (keys(%packagetab)) {
     #no specific packages #how's our extension      #no specific packages #how's our extension
     if ($key!~/^extension_\Q$extension\E&/) { next; }      if ($key!~/^extension_\Q$extension\E&/) { next; }
     &metadata_create_package_def($uri,$key,'extension_'.$extension,      &metadata_create_package_def($uri,$key,'extension_'.$extension,
  \%metathesekeys);   \%metathesekeys);
  }   }
  if (!exists($metaentry{':packages'})) {  
    if (!exists($metaentry{':packages'})
       || $packagetab{"import_defaults&extension_$extension"}) {
     foreach my $key (keys(%packagetab)) {      foreach my $key (keys(%packagetab)) {
  #no specific packages well let's get default then   #no specific packages well let's get default then
  if ($key!~/^default&/) { next; }   if ($key!~/^default&/) { next; }
Line 6609  sub gettitle { Line 6848  sub gettitle {
  }   }
  my ($map,$resid,$url)=&decode_symb($symb);   my ($map,$resid,$url)=&decode_symb($symb);
  my $title='';   my $title='';
  my %bighash;   if (!$map && $resid == 0 && $url =~/default\.sequence$/) {
  if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',      $title = $env{'course.'.$env{'request.course.id'}.'.description'};
  &GDBM_READER(),0640)) {   } else {
     my $mapid=$bighash{'map_pc_'.&clutter($map)};      if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
     $title=$bighash{'title_'.$mapid.'.'.$resid};      &GDBM_READER(),0640)) {
     untie %bighash;   my $mapid=$bighash{'map_pc_'.&clutter($map)};
    $title=$bighash{'title_'.$mapid.'.'.$resid};
    untie(%bighash);
       }
  }   }
  $title=~s/\&colon\;/\:/gs;   $title=~s/\&colon\;/\:/gs;
  if ($title) {   if ($title) {
Line 6987  sub getCODE { Line 7229  sub getCODE {
 sub rndseed {  sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();      my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!$symb) {      if (!defined($symb)) {
  unless ($symb=$wsymb) { return time; }   unless ($symb=$wsymb) { return time; }
     }      }
     if (!$courseid) { $courseid=$wcourseid; }      if (!$courseid) { $courseid=$wcourseid; }
Line 7439  sub filelocation { Line 7681  sub filelocation {
  $file=~s-^/adm/wrapper/-/-;   $file=~s-^/adm/wrapper/-/-;
  $file=~s-^/adm/coursedocs/showdoc/-/-;   $file=~s-^/adm/coursedocs/showdoc/-/-;
     }      }
   
     if ($file=~m:^/~:) { # is a contruction space reference      if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;          $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;          $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
Line 7459  sub filelocation { Line 7702  sub filelocation {
    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.     $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
        $udom.'/'.$uname.'/'.$filename;         $udom.'/'.$uname.'/'.$filename;
         }          }
       } elsif ($file =~ m-^/adm/-) {
    $location = $perlvar{'lonDocRoot'}.'/'.$file;
     } else {      } else {
         $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;          $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
         $file=~s:^/res/:/:;          $file=~s:^/res/:/:;
Line 7518  sub machine_ids { Line 7763  sub machine_ids {
     my ($hostname) = @_;      my ($hostname) = @_;
     $hostname ||= &hostname($perlvar{'lonHostID'});      $hostname ||= &hostname($perlvar{'lonHostID'});
     my @ids;      my @ids;
     my %hostname = &all_hostnames();      my %name_to_host = &all_names();
     while( my($id, $name) = each(%hostname)) {      if (ref($name_to_host{$hostname}) eq 'ARRAY') {
 # &logthis("-$id-$name-$hostname-");   return @{ $name_to_host{$hostname} };
  if ($hostname eq $name) {  
     push(@ids,$id);  
  }  
     }      }
     return @ids;      return;
 }  }
   
 sub additional_machine_domains {  sub additional_machine_domains {
Line 7569  sub declutter { Line 7811  sub declutter {
   
 sub clutter {  sub clutter {
     my $thisfn='/'.&declutter(shift);      my $thisfn='/'.&declutter(shift);
     unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) {       if ($thisfn !~ m{^/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)/}
    || $thisfn =~ m{^/adm/(includes|pages)} ) { 
        $thisfn='/res'.$thisfn;          $thisfn='/res'.$thisfn; 
     }      }
     if ($thisfn !~m|/adm|) {      if ($thisfn !~m|/adm|) {
Line 7638  sub correct_line_ends { Line 7881  sub correct_line_ends {
 sub goodbye {  sub goodbye {
    &logthis("Starting Shut down");     &logthis("Starting Shut down");
 #not converted to using infrastruture and probably shouldn't be  #not converted to using infrastruture and probably shouldn't be
    &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache))));     &logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache))));
 #converted  #converted
 #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));  #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
    &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));     &logthis(sprintf("%-20s is %s",'%homecache',length(&nfreeze(\%homecache))));
 #   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));  #   &logthis(sprintf("%-20s is %s",'%titlecache',length(&nfreeze(\%titlecache))));
 #   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));  #   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&nfreeze(\%courseresdatacache))));
 #1.1 only  #1.1 only
 #   &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));  #   &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&nfreeze(\%userresdatacache))));
 #   &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache))));  #   &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&nfreeze(\%getsectioncache))));
 #   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));  #   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&nfreeze(\%courseresversioncache))));
 #   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));  #   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&nfreeze(\%resversioncache))));
    &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));     &logthis(sprintf("%-20s is %s",'%remembered',length(&nfreeze(\%remembered))));
    &logthis(sprintf("%-20s is %s",'kicks',$kicks));     &logthis(sprintf("%-20s is %s",'kicks',$kicks));
    &logthis(sprintf("%-20s is %s",'hits',$hits));     &logthis(sprintf("%-20s is %s",'hits',$hits));
    &flushcourselogs();     &flushcourselogs();
Line 7657  sub goodbye { Line 7900  sub goodbye {
 }  }
   
 sub get_dns {  sub get_dns {
     my ($url,$func) = @_;      my ($url,$func,$ignore_cache) = @_;
       if (!$ignore_cache) {
    my ($content,$cached)=
       &Apache::lonnet::is_cached_new('dns',$url);
    if ($cached) {
       &$func($content);
       return;
    }
       }
   
       my %alldns;
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
     foreach my $dns (<$config>) {      foreach my $dns (<$config>) {
  next if ($dns !~ /^\^(\S*)/x);   next if ($dns !~ /^\^(\S*)/x);
  $dns = $1;   $alldns{$1} = 1;
       }
       while (%alldns) {
    my ($dns) = keys(%alldns);
    delete($alldns{$dns});
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
  my $request=new HTTP::Request('GET',"http://$dns$url");   my $request=new HTTP::Request('GET',"http://$dns$url");
  my $response=$ua->request($request);   my $response=$ua->request($request);
  next if ($response->is_error());   next if ($response->is_error());
  my @content = split("\n",$response->content);   my @content = split("\n",$response->content);
    &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
  &$func(\@content);   &$func(\@content);
    return;
     }      }
     close($config);      close($config);
       my $which = (split('/',$url))[3];
       &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
       open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
       my @content = <$config>;
       &$func(\@content);
       return;
 }  }
 # ------------------------------------------------------------ Read domain file  # ------------------------------------------------------------ Read domain file
 {  {
Line 7699  sub get_dns { Line 7964  sub get_dns {
     }      }
   
     sub load_domain_tab {      sub load_domain_tab {
  &get_dns('/adm/dns/domain',\&parse_domain_tab);   my ($ignore_cache) = @_;
    &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache);
  my $fh;   my $fh;
  if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {   if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
     my @lines = <$fh>;      my @lines = <$fh>;
Line 7729  sub get_dns { Line 7995  sub get_dns {
     my %hostdom;      my %hostdom;
     my %libserv;      my %libserv;
     my $loaded;      my $loaded;
       my %name_to_host;
   
     sub parse_hosts_tab {      sub parse_hosts_tab {
  my ($file) = @_;   my ($file) = @_;
Line 7740  sub get_dns { Line 8007  sub get_dns {
     $name=~s/\s//g;      $name=~s/\s//g;
     if ($id && $domain && $role && $name) {      if ($id && $domain && $role && $name) {
  $hostname{$id}=$name;   $hostname{$id}=$name;
    push(@{$name_to_host{$name}}, $id);
  $hostdom{$id}=$domain;   $hostdom{$id}=$domain;
  if ($role eq 'library') { $libserv{$id}=$name; }   if ($role eq 'library') { $libserv{$id}=$name; }
     }      }
Line 7747  sub get_dns { Line 8015  sub get_dns {
     }      }
           
     sub reset_hosts_info {      sub reset_hosts_info {
    &purge_remembered();
  &reset_domain_info();   &reset_domain_info();
  &reset_hosts_ip_info();   &reset_hosts_ip_info();
    undef(%name_to_host);
  undef(%hostname);   undef(%hostname);
  undef(%hostdom);   undef(%hostdom);
  undef(%libserv);   undef(%libserv);
Line 7756  sub get_dns { Line 8026  sub get_dns {
     }      }
   
     sub load_hosts_tab {      sub load_hosts_tab {
  &get_dns('/adm/dns/hosts',\&parse_hosts_tab);   my ($ignore_cache) = @_;
    &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache);
  open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");   open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
  my @config = <$config>;   my @config = <$config>;
  &parse_hosts_tab(\@config);   &parse_hosts_tab(\@config);
Line 7777  sub get_dns { Line 8048  sub get_dns {
  return %hostname;   return %hostname;
     }      }
   
       sub all_names {
    &load_hosts_tab() if (!$loaded);
   
    return %name_to_host;
       }
   
     sub is_library {      sub is_library {
  &load_hosts_tab() if (!$loaded);   &load_hosts_tab() if (!$loaded);
   
Line 7832  sub get_dns { Line 8109  sub get_dns {
     my %iphost;      my %iphost;
     my %name_to_ip;      my %name_to_ip;
     my %lonid_to_ip;      my %lonid_to_ip;
   
     sub get_hosts_from_ip {      sub get_hosts_from_ip {
  my ($ip) = @_;   my ($ip) = @_;
  my %iphosts = &get_iphost();   my %iphosts = &get_iphost();
Line 7862  sub get_dns { Line 8140  sub get_dns {
     }      }
           
     sub get_iphost {      sub get_iphost {
  if (%iphost) { return %iphost; }   my ($ignore_cache) = @_;
  my %hostname = &all_hostnames();  
  foreach my $id (keys(%hostname)) {   if (!$ignore_cache) {
     my $name=&hostname($id);      if (%iphost) {
    return %iphost;
       }
       my ($ip_info,$cached)=
    &Apache::lonnet::is_cached_new('iphost','iphost');
       if ($cached) {
    %iphost      = %{$ip_info->[0]};
    %name_to_ip  = %{$ip_info->[1]};
    %lonid_to_ip = %{$ip_info->[2]};
    return %iphost;
       }
    }
   
    # get yesterday's info for fallback
    my %old_name_to_ip;
    my ($ip_info,$cached)=
       &Apache::lonnet::is_cached_new('iphost','iphost');
    if ($cached) {
       %old_name_to_ip = %{$ip_info->[1]};
    }
   
    my %name_to_host = &all_names();
    foreach my $name (keys(%name_to_host)) {
     my $ip;      my $ip;
     if (!exists($name_to_ip{$name})) {      if (!exists($name_to_ip{$name})) {
  $ip = gethostbyname($name);   $ip = gethostbyname($name);
  if (!$ip || length($ip) ne 4) {   if (!$ip || length($ip) ne 4) {
     &logthis("Skipping host $id name $name no IP found");      if (defined($old_name_to_ip{$name})) {
     next;   $ip = $old_name_to_ip{$name};
    &logthis("Can't find $name defaulting to old $ip");
       } else {
    &logthis("Name $name no IP found");
    next;
       }
    } else {
       $ip=inet_ntoa($ip);
  }   }
  $ip=inet_ntoa($ip);  
  $name_to_ip{$name} = $ip;   $name_to_ip{$name} = $ip;
     } else {      } else {
  $ip = $name_to_ip{$name};   $ip = $name_to_ip{$name};
     }      }
     $lonid_to_ip{$id} = $ip;      foreach my $id (@{ $name_to_host{$name} }) {
     push(@{$iphost{$ip}},$id);   $lonid_to_ip{$id} = $ip;
       }
       push(@{$iphost{$ip}},@{$name_to_host{$name}});
  }   }
    &Apache::lonnet::do_cache_new('iphost','iphost',
         [\%iphost,\%name_to_ip,\%lonid_to_ip],
         48*60*60);
   
  return %iphost;   return %iphost;
     }      }
 }  }
Line 8268  explanation of a user role term Line 8580  explanation of a user role term
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :  get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
 All arguments are optional. Returns a hash of a roles, either for  All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space  co-author/assistant author roles for a user's Construction Space
 (default), or if $context is 'user', roles for the user himself,  (default), or if $context is 'userroles', roles for the user himself,
 In the hash, keys are set to colon-sparated $uname,$udom,and $role,  In the hash, keys are set to colon-sparated $uname,$udom,and $role,
 and value is set to colon-separated start and end times for the role.  and value is set to colon-separated start and end times for the role.
 If no username and domain are specified, will default to current  If no username and domain are specified, will default to current
Line 8420  setting for a specific $type, where $typ Line 8732  setting for a specific $type, where $typ
 @what should be a list of parameters to ask about. This routine caches  @what should be a list of parameters to ask about. This routine caches
 answers for 5 minutes.  answers for 5 minutes.
   
   =item *
   
   get_courseresdata($courseid, $domain) : dump the entire course resource
   data base, returning a hash that is keyed by the resource name and has
   values that are the resource value.  I believe that the timestamps and
   versions are also returned.
   
   
 =back  =back
   
 =head2 Course Modification  =head2 Course Modification
Line 9102  symblist($mapname,%newhash) : update sym Line 9422  symblist($mapname,%newhash) : update sym
 =back  =back
   
 =cut  =cut
   
Removed from v.1.865  
changed lines
  Added in v.1.910

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