[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.795 and 1.802

version 1.795, 2006/10/17 15:15:51 version 1.802, 2006/11/10 02:04:31
Line 536  sub compare_server_load { Line 536  sub compare_server_load {
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
   
 sub changepass {  sub changepass {
     my ($uname,$udom,$currentpass,$newpass,$server)=@_;      my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);      $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);      $newpass     = &escape($newpass);
     my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass",      my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
        $server);         $server);
     if (! $answer) {      if (! $answer) {
  &logthis("No reply on password change request to $server ".   &logthis("No reply on password change request to $server ".
Line 664  sub idget { Line 664  sub idget {
 sub idrget {  sub idrget {
     my ($udom,@unames)=@_;      my ($udom,@unames)=@_;
     my %returnhash=();      my %returnhash=();
     foreach (@unames) {      foreach my $uname (@unames) {
         $returnhash{$_}=(&userenvironment($udom,$_,'id'))[1];          $returnhash{$uname}=(&userenvironment($udom,$uname,'id'))[1];
     }      }
     return %returnhash;      return %returnhash;
 }  }
Line 675  sub idrget { Line 675  sub idrget {
 sub idput {  sub idput {
     my ($udom,%ids)=@_;      my ($udom,%ids)=@_;
     my %servers=();      my %servers=();
     foreach (keys %ids) {      foreach my $uname (keys(%ids)) {
  &cput('environment',{'id'=>$ids{$_}},$udom,$_);   &cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
         my $uhom=&homeserver($_,$udom);          my $uhom=&homeserver($uname,$udom);
         if ($uhom ne 'no_host') {          if ($uhom ne 'no_host') {
             my $id=&escape($ids{$_});              my $id=&escape($ids{$uname});
             $id=~tr/A-Z/a-z/;              $id=~tr/A-Z/a-z/;
             my $unam=&escape($_);              my $esc_unam=&escape($uname);
     if ($servers{$uhom}) {      if ($servers{$uhom}) {
  $servers{$uhom}.='&'.$id.'='.$unam;   $servers{$uhom}.='&'.$id.'='.$esc_unam;
             } else {              } else {
                 $servers{$uhom}=$id.'='.$unam;                  $servers{$uhom}=$id.'='.$esc_unam;
             }              }
         }          }
     }      }
     foreach (keys %servers) {      foreach my $server (keys(%servers)) {
         &critical('idput:'.$udom.':'.$servers{$_},$_);          &critical('idput:'.$udom.':'.$servers{$server},$server);
     }      }
 }  }
   
Line 858  sub getsection { Line 858  sub getsection {
     # If there is more than one expired role, choose the one which ended last.      # If there is more than one expired role, choose the one which ended last.
     # If there is a role which has expired, return it.      # If there is a role which has expired, return it.
     #      #
     foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',      foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
                         &homeserver($unam,$udom)))) {   &homeserver($unam,$udom)))) {
         my ($key,$value)=split(/\=/,$_);          my ($key,$value)=split(/\=/,$line,2);
         $key=&unescape($key);          $key=&unescape($key);
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);          next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;          my $section=$1;
Line 1636  sub removeuploadedurl { Line 1636  sub removeuploadedurl {
 sub removeuserfile {  sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;      my ($docuname,$docudom,$fname)=@_;
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
     return &reply("removeuserfile:$docudom/$docuname/$fname",$home);      my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home);
       if ($result eq 'ok') {
           if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
               my $metafile = $fname.'.meta';
               my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
           }
       }
       return $result;
 }  }
   
 sub mkdiruserfile {  sub mkdiruserfile {
Line 1648  sub mkdiruserfile { Line 1655  sub mkdiruserfile {
 sub renameuserfile {  sub renameuserfile {
     my ($docuname,$docudom,$old,$new)=@_;      my ($docuname,$docudom,$old,$new)=@_;
     my $home=&homeserver($docuname,$docudom);      my $home=&homeserver($docuname,$docudom);
     return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'.      my $result = &reply("renameuserfile:$docudom:$docuname:".
   &escape("$new"),$home);                          &escape("$old").':'.&escape("$new"),$home);
       if ($result eq 'ok') {
           if (($old !~ /\.meta$/) && (&is_portfolio_file($old))) {
               my $oldmeta = $old.'.meta';
               my $newmeta = $new.'.meta';
               my $metaresult = 
                   &renameuserfile($docuname,$docudom,$oldmeta,$newmeta);
           }
       }
       return $result;
 }  }
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
Line 1675  sub flushcourselogs { Line 1691  sub flushcourselogs {
 # times and course titles for all courseids  # times and course titles for all courseids
 #  #
     my %courseidbuffer=();      my %courseidbuffer=();
     foreach (keys %courselogs) {      foreach my $crsid (keys %courselogs) {
         my $crsid=$_;  
         if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.          if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
           &escape($courselogs{$crsid}),            &escape($courselogs{$crsid}),
           $coursehombuf{$crsid}) eq 'ok') {            $coursehombuf{$crsid}) eq 'ok') {
Line 1703  sub flushcourselogs { Line 1718  sub flushcourselogs {
 # Write course id database (reverse lookup) to homeserver of courses   # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse  # Is used in pickcourse
 #  #
     foreach (keys %courseidbuffer) {      foreach my $crsid (keys(%courseidbuffer)) {
         &courseidput($hostdom{$_},$courseidbuffer{$_},$_);          &courseidput($hostdom{$crsid},$courseidbuffer{$crsid},$crsid);
     }      }
 #  #
 # File accesses  # File accesses
Line 1745  sub flushcourselogs { Line 1760  sub flushcourselogs {
 # Roles  # Roles
 # Reverse lookup of user roles for course faculty/staff and co-authorship  # Reverse lookup of user roles for course faculty/staff and co-authorship
 #  #
     foreach (keys %userrolehash) {      foreach my $entry (keys(%userrolehash)) {
         my $entry=$_;  
         my ($role,$uname,$udom,$runame,$rudom,$rsec)=          my ($role,$uname,$udom,$runame,$rudom,$rsec)=
     split(/\:/,$entry);      split(/\:/,$entry);
         if (&Apache::lonnet::put('nohist_userroles',          if (&Apache::lonnet::put('nohist_userroles',
Line 1818  sub courseacclog { Line 1832  sub courseacclog {
     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {      if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
         $what.=':POST';          $what.=':POST';
         # FIXME: Probably ought to escape things....          # FIXME: Probably ought to escape things....
  foreach (keys %env) {   foreach my $key (keys(%env)) {
             if ($_=~/^form\.(.*)/) {              if ($key=~/^form\.(.*)/) {
  $what.=':'.$1.'='.$env{$_};   $what.=':'.$1.'='.$env{$key};
             }              }
         }          }
     } elsif ($fnsymb =~ m:^/adm/searchcat:) {      } elsif ($fnsymb =~ m:^/adm/searchcat:) {
Line 1882  sub get_course_adv_roles { Line 1896  sub get_course_adv_roles {
     $cid=$env{'request.course.id'} unless (defined($cid));      $cid=$env{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);      my %coursehash=&coursedescription($cid);
     my %nothide=();      my %nothide=();
     foreach (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {      foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
  $nothide{join(':',split(/[\@\:]/,$_))}=1;   $nothide{join(':',split(/[\@\:]/,$user))}=1;
     }      }
     my %returnhash=();      my %returnhash=();
     my %dumphash=      my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});              &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
     my $now=time;      my $now=time;
     foreach (keys %dumphash) {      foreach my $entry (keys %dumphash) {
  my ($tend,$tstart)=split(/\:/,$dumphash{$_});   my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }          if (($tstart) && ($tstart<0)) { next; }
         if (($tend) && ($tend<$now)) { next; }          if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }          if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$_);          my ($role,$username,$domain,$section)=split(/\:/,$entry);
  if ($username eq '' || $domain eq '') { next; }   if ($username eq '' || $domain eq '') { next; }
  if ((&privileged($username,$domain)) &&    if ((&privileged($username,$domain)) && 
     (!$nothide{$username.':'.$domain})) { next; }      (!$nothide{$username.':'.$domain})) { next; }
Line 1918  sub get_my_roles { Line 1932  sub get_my_roles {
             &dump('nohist_userroles',$udom,$uname);              &dump('nohist_userroles',$udom,$uname);
     my %returnhash=();      my %returnhash=();
     my $now=time;      my $now=time;
     foreach (keys %dumphash) {      foreach my $entry (keys(%dumphash)) {
  my ($tend,$tstart)=split(/\:/,$dumphash{$_});   my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }          if (($tstart) && ($tstart<0)) { next; }
         if (($tend) && ($tend<$now)) { next; }          if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }          if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$_);          my ($role,$username,$domain,$section)=split(/\:/,$entry);
  $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;   $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
      }       }
     return %returnhash;      return %returnhash;
Line 1944  sub getannounce { Line 1958  sub getannounce {
   
     if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {      if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
  my $announcement='';   my $announcement='';
  while (<$fh>) { $announcement .=$_; }   while (my $line = <$fh>) { $announcement .= $line; }
  close($fh);   close($fh);
  if ($announcement=~/\w/) {    if ($announcement=~/\w/) { 
     return       return 
Line 1974  sub courseiddump { Line 1988  sub courseiddump {
     foreach my $tryserver (keys %libserv) {      foreach my $tryserver (keys %libserv) {
         if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {          if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
     if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {      if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
         foreach (          foreach my $line (
                  split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.                   split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
        $sincefilter.':'.&escape($descfilter).':'.         $sincefilter.':'.&escape($descfilter).':'.
                                &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),                                 &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
                                $tryserver))) {                                 $tryserver))) {
     my ($key,$value)=split(/\=/,$_);      my ($key,$value)=split(/\=/,$line,2);
                     if (($key) && ($value)) {                      if (($key) && ($value)) {
         $returnhash{&unescape($key)}=$value;          $returnhash{&unescape($key)}=$value;
                     }                      }
Line 2008  sub dcmaildump { Line 2022  sub dcmaildump {
                                                          &escape($enddate).':';                                                           &escape($enddate).':';
  my @esc_senders=map { &escape($_)} @$senders;   my @esc_senders=map { &escape($_)} @$senders;
  $cmd.=&escape(join('&',@esc_senders));   $cmd.=&escape(join('&',@esc_senders));
  foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {   foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
             my ($key,$value) = split(/\=/,$_);              my ($key,$value) = split(/\=/,$line,2);
             if (($key) && ($value)) {              if (($key) && ($value)) {
                 $returnhash{&unescape($key)} = &unescape($value);                  $returnhash{&unescape($key)} = &unescape($value);
             }              }
Line 2032  sub get_domain_roles { Line 2046  sub get_domain_roles {
     foreach my $tryserver (keys(%libserv)) {      foreach my $tryserver (keys(%libserv)) {
         if ($hostdom{$tryserver} eq $dom) {          if ($hostdom{$tryserver} eq $dom) {
             %{$personnel{$tryserver}}=();              %{$personnel{$tryserver}}=();
             foreach (              foreach my $line (
                 split(/\&/,&reply('domrolesdump:'.$dom.':'.                  split(/\&/,&reply('domrolesdump:'.$dom.':'.
                    &escape($startdate).':'.&escape($enddate).':'.                     &escape($startdate).':'.&escape($enddate).':'.
                    &escape($rolelist), $tryserver))) {                     &escape($rolelist), $tryserver))) {
                 my($key,$value) = split(/\=/,$_);                  my ($key,$value) = split(/\=/,$line,2);
                 if (($key) && ($value)) {                  if (($key) && ($value)) {
                     $personnel{$tryserver}{&unescape($key)} = &unescape($value);                      $personnel{$tryserver}{&unescape($key)} = &unescape($value);
                 }                  }
Line 2258  sub hash2str { Line 2272  sub hash2str {
 sub hashref2str {  sub hashref2str {
   my ($hashref)=@_;    my ($hashref)=@_;
   my $result='__HASH_REF__';    my $result='__HASH_REF__';
   foreach (sort(keys(%$hashref))) {    foreach my $key (sort(keys(%$hashref))) {
     if (ref($_) eq 'ARRAY') {      if (ref($key) eq 'ARRAY') {
       $result.=&arrayref2str($_).'=';        $result.=&arrayref2str($key).'=';
     } elsif (ref($_) eq 'HASH') {      } elsif (ref($key) eq 'HASH') {
       $result.=&hashref2str($_).'=';        $result.=&hashref2str($key).'=';
     } elsif (ref($_)) {      } elsif (ref($key)) {
       $result.='=';        $result.='=';
       #print("Got a ref of ".(ref($_))." skipping.");        #print("Got a ref of ".(ref($key))." skipping.");
     } else {      } else {
  if ($_) {$result.=&escape($_).'=';} else { last; }   if ($key) {$result.=&escape($key).'=';} else { last; }
     }      }
   
     if(ref($hashref->{$_}) eq 'ARRAY') {      if(ref($hashref->{$key}) eq 'ARRAY') {
       $result.=&arrayref2str($hashref->{$_}).'&';        $result.=&arrayref2str($hashref->{$key}).'&';
     } elsif(ref($hashref->{$_}) eq 'HASH') {      } elsif(ref($hashref->{$key}) eq 'HASH') {
       $result.=&hashref2str($hashref->{$_}).'&';        $result.=&hashref2str($hashref->{$key}).'&';
     } elsif(ref($hashref->{$_})) {      } elsif(ref($hashref->{$key})) {
        $result.='&';         $result.='&';
       #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");        #print("Got a ref of ".(ref($hashref->{$key}))." skipping.");
     } else {      } else {
       $result.=&escape($hashref->{$_}).'&';        $result.=&escape($hashref->{$key}).'&';
     }      }
   }    }
   $result=~s/\&$//;    $result=~s/\&$//;
Line 2558  sub store { Line 2572  sub store {
     $$storehash{'host'}=$perlvar{'lonHostID'};      $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach my $key (keys(%$storehash)) {
         $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';          $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
Line 2594  sub cstore { Line 2608  sub cstore {
     $$storehash{'host'}=$perlvar{'lonHostID'};      $$storehash{'host'}=$perlvar{'lonHostID'};
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach my $key (keys(%$storehash)) {
         $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';          $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
Line 2627  sub restore { Line 2641  sub restore {
     my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");      my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
   
     my %returnhash=();      my %returnhash=();
     foreach (split(/\&/,$answer)) {      foreach my $line (split(/\&/,$answer)) {
  my ($name,$value)=split(/\=/,$_);   my ($name,$value)=split(/\=/,$line);
         $returnhash{&unescape($name)}=&thaw_unescape($value);          $returnhash{&unescape($name)}=&thaw_unescape($value);
     }      }
     my $version;      my $version;
     for ($version=1;$version<=$returnhash{'version'};$version++) {      for ($version=1;$version<=$returnhash{'version'};$version++) {
        foreach (split(/\:/,$returnhash{$version.':keys'})) {         foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
           $returnhash{$_}=$returnhash{$version.':'.$_};            $returnhash{$item}=$returnhash{$version.':'.$item};
        }         }
     }      }
     return %returnhash;      return %returnhash;
Line 2709  sub privileged { Line 2723  sub privileged {
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }      if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
     my $now=time;      my $now=time;
     if ($rolesdump ne '') {      if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {          foreach my $entry (split(/&/,$rolesdump)) {
     if ($_!~/^rolesdef_/) {      if ($entry!~/^rolesdef_/) {
  my ($area,$role)=split(/=/,$_);   my ($area,$role)=split(/=/,$entry);
  $area=~s/\_\w\w$//;   $area=~s/\_\w\w$//;
  my ($trole,$tend,$tstart)=split(/_/,$role);   my ($trole,$tend,$tstart)=split(/_/,$role);
  if (($trole eq 'dc') || ($trole eq 'su')) {   if (($trole eq 'dc') || ($trole eq 'su')) {
Line 2743  sub rolesinit { Line 2757  sub rolesinit {
     my $group_privs;      my $group_privs;
   
     if ($rolesdump ne '') {      if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {          foreach my $entry (split(/&/,$rolesdump)) {
   if ($_!~/^rolesdef_/) {    if ($entry!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);              my ($area,$role)=split(/=/,$entry);
     $area=~s/\_\w\w$//;      $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart,$group_privs);              my ($trole,$tend,$tstart,$group_privs);
     if ($role=~/^cr/) {       if ($role=~/^cr/) { 
Line 2875  sub set_userprivs { Line 2889  sub set_userprivs {
             }              }
         }          }
     }      }
     foreach (keys(%grouproles)) {      foreach my $group (keys(%grouproles)) {
         $$allroles{$_} = $grouproles{$_};          $$allroles{$group} = $grouproles{$group};
     }      }
     foreach (keys %{$allroles}) {      foreach my $role (keys(%{$allroles})) {
         my %thesepriv=();          my %thesepriv;
         if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }          if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; }
         foreach (split(/:/,$$allroles{$_})) {          foreach my $item (split(/:/,$$allroles{$role})) {
             if ($_ ne '') {              if ($item ne '') {
                 my ($privilege,$restrictions)=split(/&/,$_);                  my ($privilege,$restrictions)=split(/&/,$item);
                 if ($restrictions eq '') {                  if ($restrictions eq '') {
                     $thesepriv{$privilege}='F';                      $thesepriv{$privilege}='F';
                 } elsif ($thesepriv{$privilege} ne 'F') {                  } elsif ($thesepriv{$privilege} ne 'F') {
Line 2893  sub set_userprivs { Line 2907  sub set_userprivs {
             }              }
         }          }
         my $thesestr='';          my $thesestr='';
         foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }          foreach my $priv (keys(%thesepriv)) {
         $userroles->{'user.priv.'.$_} = $thesestr;      $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
    }
           $userroles->{'user.priv.'.$role} = $thesestr;
     }      }
     return ($author,$adv);      return ($author,$adv);
 }  }
Line 2904  sub set_userprivs { Line 2920  sub set_userprivs {
 sub get {  sub get {
    my ($namespace,$storearr,$udomain,$uname)=@_;     my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';     my $items='';
    foreach (@$storearr) {     foreach my $item (@$storearr) {
        $items.=escape($_).'&';         $items.=&escape($item).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
Line 2919  sub get { Line 2935  sub get {
    }     }
    my %returnhash=();     my %returnhash=();
    my $i=0;     my $i=0;
    foreach (@$storearr) {     foreach my $item (@$storearr) {
       $returnhash{$_}=&thaw_unescape($pairs[$i]);        $returnhash{$item}=&thaw_unescape($pairs[$i]);
       $i++;        $i++;
    }     }
    return %returnhash;     return %returnhash;
Line 2931  sub get { Line 2947  sub get {
 sub del {  sub del {
    my ($namespace,$storearr,$udomain,$uname)=@_;     my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';     my $items='';
    foreach (@$storearr) {     foreach my $item (@$storearr) {
        $items.=escape($_).'&';         $items.=&escape($item).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
Line 2982  sub getkeys { Line 2998  sub getkeys {
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $rep=reply("keys:$udomain:$uname:$namespace",$uhome);     my $rep=reply("keys:$udomain:$uname:$namespace",$uhome);
    my @keyarray=();     my @keyarray=();
    foreach (split(/\&/,$rep)) {     foreach my $key (split(/\&/,$rep)) {
       push (@keyarray,&unescape($_));        push(@keyarray,&unescape($key));
    }     }
    return @keyarray;     return @keyarray;
 }  }
Line 3010  sub currentdump { Line 3026  sub currentdump {
        %returnhash = %{&convert_dump_to_currentdump(\%hash)};         %returnhash = %{&convert_dump_to_currentdump(\%hash)};
    } else {     } else {
        my @pairs=split(/\&/,$rep);         my @pairs=split(/\&/,$rep);
        foreach (@pairs) {         foreach my $pair (@pairs) {
            my ($key,$value)=split(/=/,$_);             my ($key,$value)=split(/=/,$pair,2);
            my ($symb,$param) = split(/:/,$key);             my ($symb,$param) = split(/:/,$key);
            $returnhash{&unescape($symb)}->{&unescape($param)} =              $returnhash{&unescape($symb)}->{&unescape($param)} = 
                                                         &thaw_unescape($value);                                                          &thaw_unescape($value);
Line 3089  sub put { Line 3105  sub put {
    if (!$uname) { $uname=$env{'user.name'}; }     if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    foreach (keys %$storehash) {     foreach my $item (keys(%$storehash)) {
        $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';         $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
Line 3142  sub old_putstore { Line 3158  sub old_putstore {
     if (!$uname) { $uname=$env{'user.name'}; }      if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
     my %newstorehash;      my %newstorehash;
     foreach (keys %$storehash) {      foreach my $item (keys(%$storehash)) {
  my $key = $version.':'.&escape($symb).':'.$_;   my $key = $version.':'.&escape($symb).':'.$item;
  $newstorehash{$key} = $storehash->{$_};   $newstorehash{$key} = $storehash->{$item};
     }      }
     my $items='';      my $items='';
     my %allitems = ();      my %allitems = ();
     foreach (keys %newstorehash) {      foreach my $item (keys(%newstorehash)) {
  if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {   if ($item =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
     my $key = $1.':keys:'.$2;      my $key = $1.':keys:'.$2;
     $allitems{$key} .= $3.':';      $allitems{$key} .= $3.':';
  }   }
  $items.=$_.'='.&freeze_escape($newstorehash{$_}).'&';   $items.=$item.'='.&freeze_escape($newstorehash{$item}).'&';
     }      }
     foreach (keys %allitems) {      foreach my $item (keys(%allitems)) {
  $allitems{$_} =~ s/\:$//;   $allitems{$item} =~ s/\:$//;
  $items.= $_.'='.$allitems{$_}.'&';   $items.= $item.'='.$allitems{$item}.'&';
     }      }
     $items=~s/\&$//;      $items=~s/\&$//;
     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);      return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
Line 3171  sub cput { Line 3187  sub cput {
    if (!$uname) { $uname=$env{'user.name'}; }     if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    foreach (keys %$storehash) {     foreach my $item (keys(%$storehash)) {
        $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';         $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);     return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
Line 3183  sub cput { Line 3199  sub cput {
 sub eget {  sub eget {
    my ($namespace,$storearr,$udomain,$uname)=@_;     my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';     my $items='';
    foreach (@$storearr) {     foreach my $item (@$storearr) {
        $items.=escape($_).'&';         $items.=&escape($item).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
Line 3194  sub eget { Line 3210  sub eget {
    my @pairs=split(/\&/,$rep);     my @pairs=split(/\&/,$rep);
    my %returnhash=();     my %returnhash=();
    my $i=0;     my $i=0;
    foreach (@$storearr) {     foreach my $item (@$storearr) {
       $returnhash{$_}=&thaw_unescape($pairs[$i]);        $returnhash{$item}=&thaw_unescape($pairs[$i]);
       $i++;        $i++;
    }     }
    return %returnhash;     return %returnhash;
Line 3203  sub eget { Line 3219  sub eget {
   
 # ------------------------------------------------------------ tmpput interface  # ------------------------------------------------------------ tmpput interface
 sub tmpput {  sub tmpput {
     my ($storehash,$server)=@_;      my ($storehash,$server,$context)=@_;
     my $items='';      my $items='';
     foreach (keys(%$storehash)) {      foreach my $item (keys(%$storehash)) {
  $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';   $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
     }      }
     $items=~s/\&$//;      $items=~s/\&$//;
       if (defined($context)) {
           $items .= ':'.&escape($context);
       }
     return &reply("tmpput:$items",$server);      return &reply("tmpput:$items",$server);
 }  }
   
Line 3444  sub is_portfolio_url { Line 3463  sub is_portfolio_url {
     return scalar(&parse_portfolio_url($url));      return scalar(&parse_portfolio_url($url));
 }  }
   
   sub is_portfolio_file {
       my ($file) = @_;
       if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) {
           return 1;
       }
       return;
   }
   
   
 # ---------------------------------------------- Custom access rule evaluation  # ---------------------------------------------- Custom access rule evaluation
   
 sub customaccess {  sub customaccess {
Line 3452  sub customaccess { Line 3480  sub customaccess {
     $urealm=~s/^\W//;      $urealm=~s/^\W//;
     my ($udom,$ucrs,$usec)=split(/\//,$urealm);      my ($udom,$ucrs,$usec)=split(/\//,$urealm);
     my $access=0;      my $access=0;
     foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {      foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
  my ($effect,$realm,$role)=split(/\:/,$_);   my ($effect,$realm,$role)=split(/\:/,$right);
         if ($role) {          if ($role) {
    if ($role ne $urole) { next; }     if ($role ne $urole) { next; }
         }          }
         foreach (split(/\s*\,\s*/,$realm)) {          foreach my $scope (split(/\s*\,\s*/,$realm)) {
             my ($tdom,$tcrs,$tsec)=split(/\_/,$_);              my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
             if ($tdom) {              if ($tdom) {
  if ($tdom ne $udom) { next; }   if ($tdom ne $udom) { next; }
             }              }
Line 3670  sub allowed { Line 3698  sub allowed {
        if ($checkreferer) {         if ($checkreferer) {
   my $refuri=$env{'httpref.'.$orguri};    my $refuri=$env{'httpref.'.$orguri};
             unless ($refuri) {              unless ($refuri) {
                 foreach (keys %env) {                  foreach my $key (keys(%env)) {
     if ($_=~/^httpref\..*\*/) {      if ($key=~/^httpref\..*\*/) {
  my $pattern=$_;   my $pattern=$key;
                         $pattern=~s/^httpref\.\/res\///;                          $pattern=~s/^httpref\.\/res\///;
                         $pattern=~s/\*/\[\^\/\]\+/g;                          $pattern=~s/\*/\[\^\/\]\+/g;
                         $pattern=~s/\//\\\//g;                          $pattern=~s/\//\\\//g;
                         if ($orguri=~/$pattern/) {                          if ($orguri=~/$pattern/) {
     $refuri=$env{$_};      $refuri=$env{$key};
                         }                          }
                     }                      }
                 }                  }
Line 3895  sub get_symb_from_alias { Line 3923  sub get_symb_from_alias {
 sub definerole {  sub definerole {
   if (allowed('mcr','/')) {    if (allowed('mcr','/')) {
     my ($rolename,$sysrole,$domrole,$courole)=@_;      my ($rolename,$sysrole,$domrole,$courole)=@_;
     foreach (split(':',$sysrole)) {      foreach my $role (split(':',$sysrole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }          if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
         if ($pr{'cr:s'}=~/\Q$crole\E\&/) {          if ($pr{'cr:s'}=~/\Q$crole\E\&/) {
     if ($pr{'cr:s'}!~/\Q$crole\E\&\w*\Q$cqual\E/) {       if ($pr{'cr:s'}!~/\Q$crole\E\&\w*\Q$cqual\E/) { 
Line 3904  sub definerole { Line 3932  sub definerole {
             }              }
         }          }
     }      }
     foreach (split(':',$domrole)) {      foreach my $role (split(':',$domrole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:d'}!~/\Q$crole\E/) { return "refused:d:$crole"; }          if ($pr{'cr:d'}!~/\Q$crole\E/) { return "refused:d:$crole"; }
         if ($pr{'cr:d'}=~/\Q$crole\E\&/) {          if ($pr{'cr:d'}=~/\Q$crole\E\&/) {
     if ($pr{'cr:d'}!~/\Q$crole\W\&\w*\Q$cqual\E/) {       if ($pr{'cr:d'}!~/\Q$crole\W\&\w*\Q$cqual\E/) { 
Line 3913  sub definerole { Line 3941  sub definerole {
             }              }
         }          }
     }      }
     foreach (split(':',$courole)) {      foreach my $role (split(':',$courole)) {
  my ($crole,$cqual)=split(/\&/,$_);   my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:c'}!~/\Q$crole\E/) { return "refused:c:$crole"; }          if ($pr{'cr:c'}!~/\Q$crole\E/) { return "refused:c:$crole"; }
         if ($pr{'cr:c'}=~/\Q$crole\E\&/) {          if ($pr{'cr:c'}=~/\Q$crole\E\&/) {
     if ($pr{'cr:c'}!~/\Q$crole\E\&\w*\Q$cqual\E/) {       if ($pr{'cr:c'}!~/\Q$crole\E\&\w*\Q$cqual\E/) { 
Line 3961  sub log_query { Line 3989  sub log_query {
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
     if ($uhome eq 'no_host') { return 'error: no_host'; }      if ($uhome eq 'no_host') { return 'error: no_host'; }
     my $uhost=$hostname{$uhome};      my $uhost=$hostname{$uhome};
     my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys %filters));      my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys(%filters)));
     my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,      my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
                        $uhome);                         $uhome);
     unless ($queryid=~/^\Q$uhost\E\_/) { return 'error: '.$queryid; }      unless ($queryid=~/^\Q$uhost\E\_/) { return 'error: '.$queryid; }
Line 3982  sub fetch_enrollment_query { Line 4010  sub fetch_enrollment_query {
     }      }
     my $host=$hostname{$homeserver};      my $host=$hostname{$homeserver};
     my $cmd = '';      my $cmd = '';
     foreach (keys %{$affiliatesref}) {      foreach my $affiliate (keys %{$affiliatesref}) {
         $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';          $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
     }      }
     $cmd =~ s/%%$//;      $cmd =~ s/%%$//;
     $cmd = &escape($cmd);      $cmd = &escape($cmd);
Line 4004  sub fetch_enrollment_query { Line 4032  sub fetch_enrollment_query {
     } else {      } else {
         my @responses = split/:/,$reply;          my @responses = split/:/,$reply;
         if ($homeserver eq $perlvar{'lonHostID'}) {          if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach (@responses) {              foreach my $line (@responses) {
                 my ($key,$value) = split/=/,$_;                  my ($key,$value) = split(/=/,$line,2);
                 $$replyref{$key} = $value;                  $$replyref{$key} = $value;
             }              }
         } else {          } else {
             my $pathname = $perlvar{'lonDaemons'}.'/tmp';              my $pathname = $perlvar{'lonDaemons'}.'/tmp';
             foreach (@responses) {              foreach my $line (@responses) {
                 my ($key,$value) = split/=/,$_;                  my ($key,$value) = split(/=/,$line);
                 $$replyref{$key} = $value;                  $$replyref{$key} = $value;
                 if ($value > 0) {                  if ($value > 0) {
                     foreach (@{$$affiliatesref{$key}}) {                      foreach my $item (@{$$affiliatesref{$key}}) {
                         my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';                          my $filename = $dom.'_'.$key.'_'.$item.'_classlist.xml';
                         my $destname = $pathname.'/'.$filename;                          my $destname = $pathname.'/'.$filename;
                         my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);                          my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);
                         if ($xml_classlist =~ /^error/) {                          if ($xml_classlist =~ /^error/) {
Line 4174  sub auto_photoupdate { Line 4202  sub auto_photoupdate {
     my $host=$hostname{$homeserver};      my $host=$hostname{$homeserver};
     my $cmd = '';      my $cmd = '';
     my $maxtries = 1;      my $maxtries = 1;
     foreach (keys %{$affiliatesref}) {      foreach my $affiliate (keys(%{$affiliatesref})) {
         $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';          $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
     }      }
     $cmd =~ s/%%$//;      $cmd =~ s/%%$//;
     $cmd = &escape($cmd);      $cmd = &escape($cmd);
Line 4266  sub auto_instcode_defaults { Line 4294  sub auto_instcode_defaults {
             foreach my $pair (split(/\&/,$response)) {              foreach my $pair (split(/\&/,$response)) {
                 my ($name,$value)=split(/\=/,$pair);                  my ($name,$value)=split(/\=/,$pair);
                 if ($name eq 'code_order') {                  if ($name eq 'code_order') {
                     $code_order = [split(/\&/,&unescape($value))];                      @{$code_order} = split(/\&/,&unescape($value));
                 } else {                  } else {
                     $$returnhash{&unescape($name)}=&unescape($value);                      $returnhash->{&unescape($name)}=&unescape($value);
                 }                  }
             }              }
         }          }
Line 4683  sub modify_student_enrollment { Line 4711  sub modify_student_enrollment {
                        ['firstname','middlename','lastname', 'generation','id']                         ['firstname','middlename','lastname', 'generation','id']
                        ,$udom,$uname);                         ,$udom,$uname);
   
         #foreach (keys(%tmp)) {          #foreach my $key (keys(%tmp)) {
         #    &logthis("key $_ = ".$tmp{$_});          #    &logthis("key $key = ".$tmp{$key});
         #}          #}
         $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');          $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
         $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');          $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
Line 4742  sub writecoursepref { Line 4770  sub writecoursepref {
  return 'error: no such course';   return 'error: no such course';
     }      }
     my $cstring='';      my $cstring='';
     foreach (keys %prefs) {      foreach my $pref (keys(%prefs)) {
  $cstring.=escape($_).'='.escape($prefs{$_}).'&';   $cstring.=&escape($pref).'='.&escape($prefs{$pref}).'&';
     }      }
     $cstring=~s/\&$//;      $cstring=~s/\&$//;
     return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);      return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);
Line 4950  sub files_not_in_path { Line 4978  sub files_not_in_path {
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @return_files;      my @return_files;
     my $path_part;      my $path_part;
     open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);      open(IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
     while (<IN>) {      while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work          #ok, I know it's clunky, but I want it to work
         my @paths_and_file = split m!/!, $_;          my @paths_and_file = split(m|/|, $line);
         my $file_part = pop (@paths_and_file);          my $file_part = pop(@paths_and_file);
         chomp ($file_part);          chomp($file_part);
         my $path_part = join ('/', @paths_and_file);          my $path_part = join('/', @paths_and_file);
         $path_part .= '/';          $path_part .= '/';
         my $path_and_file = $path_part.$file_part;          my $path_and_file = $path_part.$file_part;
         if ($path_part ne $path) {          if ($path_part ne $path) {
             push (@return_files, ($path_and_file));              push(@return_files, ($path_and_file));
         }          }
     }      }
     close (OUT);      close(OUT);
     return (@return_files);      return (@return_files);
 }  }
   
Line 5026  sub modify_access_controls { Line 5054  sub modify_access_controls {
             for (my $i=0; $i<$numnew; $i++) {              for (my $i=0; $i<$numnew; $i++) {
                 my $newkey = $newitems[$i];                  my $newkey = $newitems[$i];
                 my $newid = &Apache::loncommon::get_cgi_id();                  my $newid = &Apache::loncommon::get_cgi_id();
                 $newkey =~ s/^(\d+)/$newid/;                  if ($newkey =~ /^\d+:/) { 
                 $translation{$1} = $newid;                      $newkey =~ s/^(\d+)/$newid/;
                       $translation{$1} = $newid;
                   } elsif ($newkey =~ /^\d+_\d+_\d+:/) {
                       $newkey =~ s/^(\d+_\d+_\d+)/$newid/;
                       $translation{$1} = $newid;
                   }
                 $new_values{$file_name."\0".$newkey} =                   $new_values{$file_name."\0".$newkey} = 
                                           $$changes{'activate'}{$newitems[$i]};                                            $$changes{'activate'}{$newitems[$i]};
                 $new_control{$newkey} = $now;                  $new_control{$newkey} = $now;
Line 5227  sub dirlist { Line 5260  sub dirlist {
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
             my $listing=reply('ls2:'.$dirRoot.'/'.$uri,              my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
                               homeserver($uname,$udom));   &homeserver($uname,$udom));
             my @listing_results;              my @listing_results;
             if ($listing eq 'unknown_cmd') {              if ($listing eq 'unknown_cmd') {
                 $listing=reply('ls:'.$dirRoot.'/'.$uri,                  $listing = &reply('ls:'.$dirRoot.'/'.$uri,
                                homeserver($uname,$udom));    &homeserver($uname,$udom));
                 @listing_results = split(/:/,$listing);                  @listing_results = split(/:/,$listing);
             } else {              } else {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);                  @listing_results = map { &unescape($_); } split(/:/,$listing);
             }              }
             return @listing_results;              return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {          } elsif(!defined($alternateDirectoryRoot)) {
             my $tryserver;              my %allusers;
             my %allusers=();              foreach my $tryserver (keys(%libserv)) {
             foreach $tryserver (keys %libserv) {  
                 if($hostdom{$tryserver} eq $udom) {                  if($hostdom{$tryserver} eq $udom) {
                     my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.                      my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
                                       $udom, $tryserver);   $udom, $tryserver);
                     my @listing_results;                      my @listing_results;
                     if ($listing eq 'unknown_cmd') {                      if ($listing eq 'unknown_cmd') {
                         $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.                          $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
                                        $udom, $tryserver);    $udom, $tryserver);
                         @listing_results = split(/:/,$listing);                          @listing_results = split(/:/,$listing);
                     } else {                      } else {
                         @listing_results =                          @listing_results =
Line 5257  sub dirlist { Line 5289  sub dirlist {
                     if ($listing_results[0] ne 'no_such_dir' &&                       if ($listing_results[0] ne 'no_such_dir' && 
                         $listing_results[0] ne 'empty'       &&                          $listing_results[0] ne 'empty'       &&
                         $listing_results[0] ne 'con_lost') {                          $listing_results[0] ne 'con_lost') {
                         foreach (@listing_results) {                          foreach my $line (@listing_results) {
                             my ($entry,@stat)=split(/&/,$_);                              my ($entry) = split(/&/,$line,2);
                             $allusers{$entry}=1;                              $allusers{$entry} = 1;
                         }                          }
                     }                      }
                 }                  }
             }              }
             my $alluserstr='';              my $alluserstr='';
             foreach (sort keys %allusers) {              foreach my $user (sort(keys(%allusers))) {
                 $alluserstr.=$_.'&user:';                  $alluserstr.=$user.'&user:';
             }              }
             $alluserstr=~s/:$//;              $alluserstr=~s/:$//;
             return split(/:/,$alluserstr);              return split(/:/,$alluserstr);
         } else {          } else {
             my @emptyResults = ();              return ('missing user name');
             push(@emptyResults, 'missing user name');  
             return split(':',@emptyResults);  
         }          }
     } elsif(!defined($alternateDirectoryRoot)) {      } elsif(!defined($alternateDirectoryRoot)) {
         my $tryserver;          my $tryserver;
         my %alldom=();          my %alldom=();
         foreach $tryserver (keys %libserv) {          foreach $tryserver (keys(%libserv)) {
             $alldom{$hostdom{$tryserver}}=1;              $alldom{$hostdom{$tryserver}}=1;
         }          }
         my $alldomstr='';          my $alldomstr='';
         foreach (sort keys %alldom) {          foreach my $domain (sort(keys(%alldom))) {
             $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'/&domain:';              $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';
         }          }
         $alldomstr=~s/:$//;          $alldomstr=~s/:$//;
         return split(/:/,$alldomstr);                 return split(/:/,$alldomstr);       
     } else {      } else {
         my @emptyResults = ();          return ('missing domain');
         push(@emptyResults, 'missing domain');  
         return split(':',@emptyResults);  
     }      }
 }  }
   
Line 6286  sub symbverify { Line 6314  sub symbverify {
         }          }
         if ($ids) {          if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)  # ------------------------------------------------------------------- Has ID(s)
     foreach (split(/\,/,$ids)) {      foreach my $id (split(/\,/,$ids)) {
        my ($mapid,$resid)=split(/\./,$_);         my ($mapid,$resid)=split(/\./,$id);
                if (                 if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)    &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) {      eq $symb) { 
    if (($env{'request.role.adv'}) ||     if (($env{'request.role.adv'}) ||
        $bighash{'encrypted_'.$_} eq $env{'request.enc'}) {         $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
        $okay=1;          $okay=1; 
    }     }
        }         }
Line 6435  sub symbread { Line 6463  sub symbread {
                  } elsif (!$donotrecurse) {                   } elsif (!$donotrecurse) {
 # ------------------------------------------ There is more than one possibility  # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;                       my $realpossible=0;
                      foreach (@possibilities) {                       foreach my $id (@possibilities) {
  my $file=$bighash{'src_'.$_};   my $file=$bighash{'src_'.$id};
                          if (&allowed('bre',$file)) {                           if (&allowed('bre',$file)) {
              my ($mapid,$resid)=split(/\./,$_);               my ($mapid,$resid)=split(/\./,$id);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {                              if ($bighash{'map_type_'.$mapid} ne 'page') {
  $realpossible++;   $realpossible++;
                                 $syval=&encode_symb($bighash{'map_id_'.$mapid},                                  $syval=&encode_symb($bighash{'map_id_'.$mapid},
Line 6997  sub readfile { Line 7025  sub readfile {
     my $fh;      my $fh;
     open($fh,"<$file");      open($fh,"<$file");
     my $a='';      my $a='';
     while (<$fh>) { $a .=$_; }      while (my $line = <$fh>) { $a .= $line; }
     return $a;      return $a;
 }  }
   
Line 7208  BEGIN { Line 7236  BEGIN {
     %domain_auth_arg_def = ();      %domain_auth_arg_def = ();
     my $fh;      my $fh;
     if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {      if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
        while (<$fh>) {   while (my $line = <$fh>) {
            next if (/^(\#|\s*$)/);             next if ($line =~ /^(\#|\s*$)/);
 #           next if /^\#/;  #           next if /^\#/;
            chomp;             chomp $line;
            my ($domain, $domain_description, $def_auth, $def_auth_arg,             my ($domain, $domain_description, $def_auth, $def_auth_arg,
        $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_);         $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);
    $domain_auth_def{$domain}=$def_auth;     $domain_auth_def{$domain}=$def_auth;
            $domain_auth_arg_def{$domain}=$def_auth_arg;             $domain_auth_arg_def{$domain}=$def_auth_arg;
    $domaindescription{$domain}=$domain_description;     $domaindescription{$domain}=$domain_description;
Removed from v.1.795  
changed lines
  Added in v.1.802

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