[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.147 and 1.149

version 1.147, 2001/08/09 19:28:47 version 1.149, 2001/08/16 11:25:03
Line 122 Line 122
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer  # 6/1 Gerd Kortemeyer
 # July Guy Albertelli  # July Guy Albertelli
 # 8/4,8/7,8/8,8/9 Gerd Kortemeyer  # 8/4,8/7,8/8,8/9,8/11,8/16 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 659  sub log { Line 659  sub log {
     return critical("log:$dom:$nam:$what",$hom);      return critical("log:$dom:$nam:$what",$hom);
 }  }
   
   # ----------------------------------------------------------- Check out an item
   
   
   sub checkout {
       my ($symb,$tuname,$tudom,$tcrsid)=@_;
       my $now=time;
       my $lonhost=$perlvar{'lonHostID'};
       my $infostr=&escape(
                    $tuname.'&'.
                    $tudom.'&'.
                    $tcrsid.'&'.
                    $symb.'&'.
    $now.'&'.$ENV{'REMOTE_ADDR'});
       my $token=&reply('tmpput:'.$infostr,$lonhost);
       if ($token=~/^error\:/) { return ''; }
       $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
       $token=~tr/a-z/A-Z/;
   
       my %infohash=('token' => $token,
                     'checktime' => $now,
                     'remote' => $ENV{'REMOTE_ADDR'});
   
       unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
          return '';
       }    
   
       if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
                            &escape('Checkout '.$infostr.' - '.
                                                    $token)) ne 'ok') {
    return '';
       }
   }
   
   # ------------------------------------------------------------ Check in an item
   
   sub checkin {
       my $token=shift;
   }
   
 # --------------------------------------------- Set Expire Date for Spreadsheet  # --------------------------------------------- Set Expire Date for Spreadsheet
   
 sub expirespread {  sub expirespread {
Line 1108  sub allowed { Line 1147  sub allowed {
            }             }
        }         }
                 
        if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {         if ($checkreferer) {
   my $refuri=$ENV{'HTTP_REFERER'};    my $refuri=$ENV{'httpref.'.$uri};
           $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;  
           $refuri=&declutter($refuri);              unless ($refuri) {
                   map {
       if ($_=~/^httpref\..*\*/) {
    my $pattern=$_;
                           $pattern=~s/\*/\[\^\/\]\+/g;
                           $pattern=~s/\//\\\//g;
                           if ($uri=~/$pattern/) {
       $refuri=$ENV{$_};
                           }
                       }
                   } keys %ENV;
               }
            if ($refuri) { 
           my @uriparts=split(/\//,$refuri);            my @uriparts=split(/\//,$refuri);
           my $filename=$uriparts[$#uriparts];            my $filename=$uriparts[$#uriparts];
           my $pathname=$refuri;            my $pathname=$refuri;
Line 1129  sub allowed { Line 1180  sub allowed {
               }                }
             }              }
           }            }
           }
        }         }
    }     }
   
Removed from v.1.147  
changed lines
  Added in v.1.149

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