File:  [LON-CAPA] / loncom / publisher / lonpubdir.pm
Revision 1.17: download - view: text, annotated - select for diffs
Sat Dec 15 20:48:47 2001 UTC (22 years, 5 months ago) by harris41
Branches: MAIN
CVS tags: HEAD
remove lonnet::fileembstyle reference (use loncommon instead) and add
POD documentation -Scott Harrison

# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonpubdir.pm,v 1.17 2001/12/15 20:48:47 harris41 Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# 
# (TeX Content Handler
#
# YEAR=2000
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
# YEAR=2001
# 03/23 Guy Albertelli
# 03/24,03/29 Gerd Kortemeyer)
# 03/31,04/03,05/09,06/23,08/18,08/20 Gerd Kortemeyer
# 12/15 Scott Harrison
#
###

package Apache::lonpubdir;

use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;
use Apache::loncommon();

sub handler {

  my $r=shift;

  my $fn;

  if ($ENV{'form.filename'}) {
      $fn=$ENV{'form.filename'};
      $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
      $fn=~s/\/[^\/]+$//;
  } else {
      $fn=$r->filename();
  }

  my $uname;
  my $udom;

  ($uname,$udom)=
    &Apache::loncacc::constructaccess(
             $fn,$r->dir_config('lonDefDomain')); 
  unless (($uname) && ($udom)) {
     $r->log_reason($uname.' at '.$udom.
         ' trying to publish file '.$ENV{'form.filename'}.
         ' ('.$fn.') - not authorized', 
         $r->filename); 
     return HTTP_NOT_ACCEPTABLE;
  }
     
  $fn=~s/\/$//;

  unless ($fn) { 
     $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
         ' trying to list empty directory', $r->filename); 
     return HTTP_NOT_FOUND;
  } 

# ----------------------------------------------------------- Start page output


  $r->content_type('text/html');
  $r->send_http_header;

  $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');

  $r->print(
   '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');

  my $thisdisfn=$fn;
  $thisdisfn=~s/^\/home\/$uname\/public_html//;
  
  $r->print('<h1>Construction Space Directory <tt>'.$thisdisfn.'/</tt></h1>');
  
  if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
          $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
               '</font></h3>');
  }


  my $docroot=$r->dir_config('lonDocRoot');

  my $resdir=$docroot.'/res/'.$udom.'/'.$uname.$thisdisfn;
  my $linkdir='/~'.$uname.$thisdisfn;

  $r->print('<table border=2>'.
 '<tr><th>Filename</th><th>Modified</th><th>Status</th><th>&nbsp;</th></tr>');

  my $filename;
  my $dirptr=16384;

  opendir(DIR,$fn);
  my @files=sort(readdir(DIR));
  foreach my $filename (@files) {
     my ($cdev,$cino,$cmode,$cnlink,
         $cuid,$cgid,$crdev,$csize,
         $catime,$cmtime,$cctime,
         $cblksize,$cblocks)=stat($fn.'/'.$filename);

     my $extension='';
     if ($filename=~/\.(\w+)$/) { $extension=$1; }
     if ($cmode&$dirptr) {
         my $disfilename=$filename;
         if ($filename eq '..') {
	     $disfilename='<i>Parent Directory</i>';
         }
         unless ((($filename eq '..') && ($thisdisfn eq '')) ||
                 ($filename eq '.')) {
           $r->print('<tr bgcolor=#BBBBFF'.
           '><td><a href="'.$linkdir.'/'.$filename.'">'.$disfilename.
 '</a></td><td>'.localtime($cmtime).'</td><td>&nbsp;</td><td>&nbsp;</td></tr>'
           );
         }
     } elsif (&Apache::loncommon::fileembstyle($extension) ne 'hdn') {
         my $status='Unpublished';
         my $bgcol='#FFBBBB';
         if (-e $resdir.'/'.$filename) {
            my ($rdev,$rino,$rmode,$rnlink,
                $ruid,$rgid,$rrdev,$rsize,
                $ratime,$rmtime,$rctime,
                $rblksize,$rblocks)=stat($resdir.'/'.$filename);
            if ($rmtime>=$cmtime) {
		$status='Published';
                $bgcol='#BBFFBB';
            } else {
                $status='Modified';
                $bgcol='#FFFFBB';
                if 
         (&Apache::loncommon::fileembstyle(($filename=~/\.(\w+)$/)) eq 'ssi') {
                   $status.='<br><a href="/adm/diff?filename=/~'.$uname.
                                         $thisdisfn.'/'.$filename.
		       '&versionone=priv" target=cat>Diffs</a>';
	        }
            }   
            $status.='<br><a href="/adm/retrieve?filename=/~'.$uname.
              $thisdisfn.'/'.$filename.'" target=cat>Retrieve</a>';
	 }
         $r->print('<tr bgcolor='.$bgcol.
         '><td><a href="'.$linkdir.'/'.$filename.'">'.$filename.
         '</a></td><td>'.localtime($cmtime).'</td><td>'.$status.'</td>'.
     '<td><a target="_parent" href="/adm/publish?filename=/~'.$uname.
                                      $thisdisfn.'/'.$filename.'">'.
         'Publish</a></td></tr>');
     } else {
	# "hidden" extension and not a directory, so hide it away.
     }
  }
  closedir(DIR);

  $r->print('</table></body></html>');
  return OK;  
}

1;
__END__

=head1 NAME

Apache::lonpubdir - Publication Handler for Directories

=head1 SYNOPSIS

Invoked (for various locations) by /etc/httpd/conf/srm.conf:

<LocationMatch "^/\~.*/$">
PerlAccessHandler       Apache::loncacc
SetHandler perl-script
PerlHandler Apache::lonpubdir
ErrorDocument     403 /adm/login
ErrorDocument     404 /adm/notfound.html
ErrorDocument     406 /adm/unauthorized.html
ErrorDocument	  500 /adm/errorhandler
</LocationMatch>

<Location /adm/pubdir>
PerlAccessHandler       Apache::lonacc
SetHandler perl-script
PerlHandler Apache::lonpubdir
ErrorDocument     403 /adm/login
ErrorDocument     404 /adm/notfound.html
ErrorDocument     406 /adm/unauthorized.html
ErrorDocument	  500 /adm/errorhandler
</Location>

=head1 INTRODUCTION

This module enables cookie based authentication and is used
to control access for many different LON-CAPA URIs.

Whenever the client sends the cookie back to the server, 
this cookie is handled by either lonacc.pm or loncacc.pm
(see srm.conf for what is invoked when).  If
the cookie is missing or invalid, the user is re-challenged
for login information.

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head1 HANDLER SUBROUTINE

This routine is called by Apache and mod_perl.

=over 4

=item *

read in information

=item *

start page output

=item *

run through list of files and attempt to publish unhidden files

=back

=cut

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