[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.870 and 1.873

version 1.870, 2007/04/12 00:03:08 version 1.873, 2007/05/11 01:48:19
Line 33  use strict; Line 33  use strict;
 use LWP::UserAgent();  use LWP::UserAgent();
 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;
Line 1064  my $kicks=0; Line 1065  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 1111  sub do_cache_new { Line 1115  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);      if (!($memcache->set($id,$setvalue,$time))) {
    &logthis("caching of id -> $id  failed");
       }
     # 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 4480  sub auto_validate_courseID { Line 4486  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 5293  sub save_selected_files { Line 5311  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 7709  sub get_dns { Line 7727  sub get_dns {
  return;   return;
     }      }
     close($config);      close($config);
     &logthis("unable to contact DNS defaulting to on disk file\n");      my $which = (split('/',$url))[3];
     open($config,"<$perlvar{'lonTabDir'}/dns_hosts.tab");      &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
       open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;      my @content = <$config>;
     &$func(\@content);      &$func(\@content);
     return;      return;
Removed from v.1.870  
changed lines
  Added in v.1.873

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