Annotation of loncom/lonencurl.pm, revision 1.7

1.4       albertel    1: 
1.1       albertel    2: # The LearningOnline Network
                      3: # URL translation for encrypted filenames
                      4: #
1.7     ! raeburn     5: # $Id: lonencurl.pm,v 1.6 2016/02/22 03:36:57 raeburn Exp $
1.1       albertel    6: #
                      7: # Copyright Michigan State University Board of Trustees
                      8: #
                      9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     10: #
                     11: # LON-CAPA is free software; you can redistribute it and/or modify
                     12: # it under the terms of the GNU General Public License as published by
                     13: # the Free Software Foundation; either version 2 of the License, or
                     14: # (at your option) any later version.
                     15: #
                     16: # LON-CAPA is distributed in the hope that it will be useful,
                     17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     19: # GNU General Public License for more details.
                     20: #
                     21: # You should have received a copy of the GNU General Public License
                     22: # along with LON-CAPA; if not, write to the Free Software
                     23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     24: #
                     25: # /home/httpd/html/adm/gpl.txt
                     26: #
                     27: # http://www.lon-capa.org/
                     28: #
                     29: 
                     30: package Apache::lonencurl;
                     31: 
                     32: use strict;
                     33: use Apache::Constants qw(:common :remotehost);
                     34: use Apache::lonnet;
                     35: use Apache::lonenc;
1.5       raeburn    36: use GDBM_File;
1.1       albertel   37: 
                     38: sub handler {
                     39:     my $r = shift;
1.4       albertel   40: 
                     41:     $env{'request.enc'}=1;
                     42: 
                     43:     my $handle = &Apache::lonnet::check_for_valid_session($r);
                     44:     if ($handle ne '') {
1.1       albertel   45: # Initialize Environment
1.4       albertel   46: 	my $lonidsdir=$r->dir_config('lonIDsDir');
                     47: 	&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.5       raeburn    48: # Decrypt URL, if appropriate, and redirect
                     49:         my $redirect;
                     50:         my ($decrypted,$encnum,$remainder) = &checkdecryption($r->uri);
                     51:         if (($encnum ne '') && ($remainder ne '')) {
                     52:             my $referrer = $r->headers_in->{'Referer'} || '';
                     53:             my $host = $r->headers_in->{'Host'};
                     54:             my $decryptreferrer;
                     55:             if ($referrer =~ m{^https?://\Q$host\E(/enc/\Q$encnum\E/[^?]+)}) {
                     56:                 ($decryptreferrer) = &checkdecryption($1);
                     57:             }
                     58:             if ($decryptreferrer eq '') {
                     59:                 if ($env{'request.course.fn'} ne '') {
                     60:                     my %symbhash;
                     61:                     if (tie(%symbhash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                     62:                         &GDBM_READER(),0640)) {
                     63:                         my $lastsymb=$symbhash{'last_known'};
                     64:                         untie(%symbhash);
                     65:                         (undef,undef,$decryptreferrer)=&Apache::lonnet::decode_symb($lastsymb);
                     66:                         $decryptreferrer = &Apache::lonnet::clutter($decryptreferrer);
                     67:                     }
                     68:                 }
                     69:             }
                     70:             if ($decryptreferrer ne '') {
                     71:                 my ($referrerpath) = ($decryptreferrer =~ m{^(.+/)[^/]+$});
                     72:                 if (($env{'httpref.'.$referrerpath.$remainder} eq $decryptreferrer) ||
                     73:                     ($env{'httpref.'.$referrerpath.'*'} eq $decryptreferrer) ||
                     74:                     ($env{'httpref.'.$referrerpath} eq $decryptreferrer)) {
                     75:                    $redirect=$referrerpath.$remainder;
                     76:                 }
                     77:             }
                     78:         }
1.6       raeburn    79:         my $anchor;
1.5       raeburn    80:         if ($redirect eq '') {
                     81:             $redirect=&Apache::lonenc::unencrypted($r->uri);
1.6       raeburn    82:             if ($redirect =~ m{^/adm/wrapper/ext/[^\#]+(\#.+)$}) {
1.7     ! raeburn    83:                 $anchor = $1;
        !            84:                 $redirect =~ s/\#.+$//;
        !            85:             } elsif (($redirect =~ m{^https?://}) && ($r->args)) {
        !            86:                 my $symb;
        !            87:                 foreach my $item (split(/\&/,$r->args)) {
        !            88:                     my ($key,$value) = split(/=/,$item);
        !            89:                     if ($key eq 'symb') {
        !            90:                         $symb = &Apache::lonenc::unencrypted($value);
        !            91:                         last;
        !            92:                     }
        !            93:                 }
        !            94:                 if ($symb) {
        !            95:                     my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb);
        !            96:                     if (($map =~ /\.page$/) && ($res =~ m{^ext/})) {
        !            97:                          if ($res =~ /(\#[^#]+)$/) {
        !            98:                              $anchor = $1;
        !            99:                          }
        !           100:                          $r->headers_out->set(Location => $redirect.$anchor);
        !           101:                          return REDIRECT;
        !           102:                     }
        !           103:                 }
1.6       raeburn   104:             }
1.5       raeburn   105:         }
1.4       albertel  106: 	if ($r->args) { $redirect.='?'.$r->args; }
1.6       raeburn   107: 	$r->internal_redirect($redirect.$anchor);
1.4       albertel  108: 	return OK;
1.1       albertel  109:     }
                    110:     return FORBIDDEN;
                    111: }
1.2       albertel  112: 
1.5       raeburn   113: sub checkdecryption {
                    114:     my ($uri) = @_;
                    115:     my ($encnum,$encname,$rest) = ($uri =~ m{^/enc/(\d+)/([^.]+)(.*)$});
                    116:     my $enclength = length($encname);
                    117:     my $rem = $enclength%16;
                    118:     if (($encname =~ /[^a-f0-9]/) || ($rem != 0) || ($enclength < 16)) {
                    119:         return ('',$encnum,$encname.$rest);
                    120:     } else {
                    121:         return (&Apache::lonenc::unencrypted($uri));
                    122:     }
                    123: }
                    124: 
1.2       albertel  125: 1;
                    126: __END__

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