Return to loncgi.pm CVS log

Up to [LON-CAPA] / loncom / cgi

- Create new module - lonauthcgi.pm -to contain modules previously in loncgi.pm
    which require lonnet.pm, so loncgi.pm need not import lonnet.pm.
- Moved &check_ipbased_access(), &can_view(), &unauthorized_msg(), and
    &serverstatus_titles() from  loncgi.pm to lonauthcgi.pm.

    1: #
    2: # LON-CAPA helpers for cgi-bin scripts
    3: #
    4: # $Id: loncgi.pm,v 1.11 2008/12/25 01:51:03 raeburn 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, loading the user's
   40: environment, and retrieving arguments passed in via a CGI's Query String.
   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 lib '/home/httpd/lib/perl/';
   57: use CGI();
   58: use CGI::Cookie();
   59: use Fcntl qw(:flock);
   60: use LONCAPA;
   61: use LONCAPA::Configuration();
   62: use GDBM_File;
   63: use Apache::lonlocal;
   64: 
   65: my $lonidsdir;
   66: 
   67: BEGIN {
   68:     my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
   69:     delete $perlvar->{'lonReceipt'};
   70:     $lonidsdir = $perlvar->{'lonIDsDir'};
   71: }
   72: 
   73: 
   74: #############################################
   75: #############################################
   76: 
   77: =pod
   78: 
   79: =item check_cookie_and_load_env()
   80: 
   81: Inputs: 1 ( optional). When called from a handler in mod_perl,
   82:         pass in the request object.
   83: 
   84: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
   85: Loads the users environment into the %env hash if the cookie is correct.
   86: 
   87: =cut
   88: 
   89: #############################################
   90: #############################################
   91: sub check_cookie_and_load_env {
   92:     my ($r) = @_;
   93:     my %cookies;
   94:     if (ref($r)) {
   95:         %cookies = CGI::Cookie->fetch($r);    
   96:     } else {
   97:         %cookies = CGI::Cookie->fetch();
   98:     }
   99:     if (exists($cookies{'lonID'}) && 
  100:         -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
  101:         # cookie found
  102:         &transfer_profile_to_env($cookies{'lonID'}->value);
  103:         return 1;
  104:     } else {
  105:         # No cookie found
  106:         return 0;
  107:     }
  108: }
  109: 
  110: #############################################
  111: #############################################
  112: 
  113: =pod
  114: 
  115: =item check_cookie()
  116: 
  117: Inputs: none
  118: 
  119: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
  120: 
  121: =cut
  122: 
  123: #############################################
  124: #############################################
  125: sub check_cookie {
  126:     my %cookies=fetch CGI::Cookie;
  127:     if (exists($cookies{'lonID'}) && 
  128:         -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
  129:         # cookie found
  130:         return 1;
  131:     } else {
  132:         # No cookie found
  133:         return 0;
  134:     }
  135: }
  136: 
  137: #############################################
  138: #############################################
  139: 
  140: =pod
  141: 
  142: =item transfer_profile_to_env()
  143: 
  144: Load the users environment into the %env hash.
  145: 
  146: Inputs: $handle, the name of the users LON-CAPA cookie.
  147: 
  148: Returns: undef
  149: 
  150: =cut
  151: 
  152: #############################################
  153: #############################################
  154: sub transfer_profile_to_env {
  155:     my ($handle)=@_;
  156:    if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
  157: 	    0640)) {
  158: 	%Apache::lonnet::env = %disk_env;
  159: 	untie(%disk_env);
  160:     }
  161:     $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
  162:     return undef;
  163: }
  164: 
  165: #############################################
  166: #############################################
  167: 
  168: =pod
  169: 
  170: =item missing_cookie_msg()
  171: 
  172: Inputs: none
  173: Returns: HTML for a page indicating cookie information absent. 
  174: 
  175: =cut
  176: 
  177: #############################################
  178: #############################################
  179: sub missing_cookie_msg {
  180:     my %lt = &Apache::lonlocal::texthash (
  181:                         cook => 'Bad Cookie',
  182:                         your => 'Your cookie information is incorrect.',
  183:              );
  184:     return <<END;
  185: <html>
  186: <head><title>$lt{'cook'}</title></head>
  187: <body>
  188: $lt{'your'}
  189: </body>
  190: </html>
  191: END
  192: 
  193: }
  194: 
  195: #############################################
  196: #############################################
  197: 
  198: =pod
  199: 
  200: =cgi_getitems()
  201: 
  202: Inputs: $query (the CGI query string), and $getitems, a reference to a hash 
  203: 
  204: Returns: nothing
  205: 
  206: Side Effects: populates $getitems hash ref with key => value
  207:               where each key is the name of the form item in the query string
  208:               and value is an array of corresponding values. 
  209: 
  210: =cut
  211: 
  212: #############################################
  213: #############################################
  214: sub cgi_getitems {
  215:     my ($query,$getitems)= @_;
  216:     foreach (split(/&/,$query)) {
  217:         my ($name, $value) = split(/=/,$_);
  218:         $name = &unescape($name);
  219:         $value =~ tr/+/ /;
  220:         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  221:         push(@{$$getitems{$name}},$value);
  222:     }
  223:     return;
  224: }
  225: 
  226: =pod
  227: 
  228: =back
  229: 
  230: =cut
  231: 
  232: 1;
  233: 
  234: __END__