Return to loncgi.pm CVS log

Up to [LON-CAPA] / loncom / cgi

- session env is stored escaped now

    1: #
    2: # LON-CAPA helpers for cgi-bin scripts
    3: #
    4: # $Id: loncgi.pm,v 1.6 2006/04/10 17:46:04 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: #############################################
   29: #############################################
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: loncgi
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: Provides subroutines for checking a LON-CAPA cookie and loading the users
   40: environment.
   41: 
   42: =head1 Subroutines
   43: 
   44: =over 4 
   45: 
   46: =cut
   47: 
   48: #############################################
   49: #############################################
   50: package LONCAPA::loncgi;
   51: 
   52: use strict;
   53: use warnings FATAL=>'all';
   54: no warnings 'uninitialized';
   55: 
   56: use CGI();
   57: use CGI::Cookie();
   58: use Fcntl qw(:flock);
   59: use LONCAPA::Configuration();
   60: 
   61: my $lonidsdir;
   62: 
   63: BEGIN {
   64:     my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
   65:     delete $perlvar->{'lonReceipt'};
   66:     $lonidsdir = $perlvar->{'lonIDsDir'};
   67: }
   68: 
   69: #############################################
   70: #############################################
   71: 
   72: =pod
   73: 
   74: =item check_cookie_and_load_env
   75: 
   76: Inputs: none
   77: 
   78: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
   79: Loads the users environment into the %env hash if the cookie is correct.
   80: 
   81: =cut
   82: 
   83: #############################################
   84: #############################################
   85: sub check_cookie_and_load_env {
   86:     my %cookies=fetch CGI::Cookie;
   87:     if (exists($cookies{'lonID'}) && 
   88:         -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
   89:         # cookie found
   90:         &transfer_profile_to_env($cookies{'lonID'}->value);
   91:         return 1;
   92:     } else {
   93:         # No cookie found
   94:         return 0;
   95:     }
   96: }
   97: 
   98: #############################################
   99: #############################################
  100: 
  101: =pod
  102: 
  103: =item check_cookie
  104: 
  105: Inputs: none
  106: 
  107: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
  108: 
  109: =cut
  110: 
  111: #############################################
  112: #############################################
  113: sub check_cookie {
  114:     my %cookies=fetch CGI::Cookie;
  115:     if (exists($cookies{'lonID'}) && 
  116:         -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
  117:         # cookie found
  118:         return 1;
  119:     } else {
  120:         # No cookie found
  121:         return 0;
  122:     }
  123: }
  124: 
  125: #############################################
  126: #############################################
  127: 
  128: =pod
  129: 
  130: =item transfer_profile_to_env
  131: 
  132: Load the users environment into the %env hash.
  133: 
  134: Inputs: $handle, the name of the users LON-CAPA cookie.
  135: 
  136: Returns: undef
  137: 
  138: =cut
  139: 
  140: #############################################
  141: #############################################
  142: sub transfer_profile_to_env {
  143:     my ($handle)=@_;
  144:     my @profile;
  145:     {
  146:         open(IDFILE, "<$lonidsdir/$handle.id");
  147:         flock(IDFILE,LOCK_SH);
  148:         @profile=<IDFILE>;
  149:         close(IDFILE);
  150:     }
  151:     foreach my $envrow (@profile) {
  152:         chomp($envrow);
  153:         my ($envname,$envvalue)=split(/=/,$envrow,2);
  154: 	$envname  = &unescape($envname);
  155: 	$envvalue = &unescape($envvalue);
  156:         $Apache::lonnet::env{$envname} = $envvalue;
  157:     }
  158:     $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
  159:     return undef;
  160: }
  161: 
  162: #############################################
  163: #############################################
  164: 
  165: sub escape {
  166:     my $str=shift;
  167:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  168:     return $str;
  169: }
  170: 
  171: # ----------------------------------------------------- Un-Escape Special Chars
  172: 
  173: sub unescape {
  174:     my $str=shift;
  175:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  176:     return $str;
  177: }
  178: 
  179: 
  180: =pod
  181: 
  182: =back
  183: 
  184: =cut
  185: 
  186: 1;
  187: 
  188: __END__