B.1 DirLister

#!/soft/bin/perl

#----------------------------------------

#       dir.cgi         Anzeige des Verzeichnis-Inhalts

#                       HTML-Ausgabe aller Dokumente eines Verzeichnisses

#       Autor:          Christoph Metten, 27.08.1997

#                       fuer die Fachhochschule Regensburg

#       Aenderungen:    29.08.97 cm     SSL-Server-kompatibel

#----------------------------------------

 

use lib '/soft/lib';

use CGI;

use strict;

 

my( $wwwurl, $q, $dir, $urldir, $parentdir, $scripturl, $filename, $tmp );

 

#-------------

# SSL-Webserver ?

if( $ENV{'HTTPS'} ) {

        $wwwurl = "https://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}";

} else {

        $wwwurl = "http://$ENV{'SERVER_NAME'}:$ENV{'SERVER_PORT'}";

}

 

#-------------

if( $ENV{'SCRIPT_NAME'} =~ /index\.cgi$/ ) {

        $scripturl = $wwwurl;

} else {

        $scripturl = $wwwurl.$ENV{'SCRIPT_NAME'};

}

 

$q = new CGI;

 

#-------------

# Verzeichnisnamen

if( $ENV{'PATH_TRANSLATED'} ) {

        $urldir = $ENV{'PATH_INFO'};

        $dir = $ENV{'PATH_TRANSLATED'};

} else {

        $urldir = $ENV{'SCRIPT_NAME'};

        $urldir =~ s/\/dir\.cgi//;              # original Scriptname

        $urldir =~ s/\/index\.cgi//;            # bei Verwendung als Index

        $dir = $ENV{'DOCUMENT_ROOT'}.$urldir;

}

 

#-------------

# Ziel = Verzeichnis ?

if( (! -e $dir) or (! -d $dir) ) {

        print $q->header( -type=>'text/html'

                          -status=>'401 Unauthorized'  );

        print $q->start_html(   -title=>'falsche Ressource',

                                -author=>'cmetten@intern.fh-regensburg.de');

        print "<h1>Die angegebene Ressource kann nicht verwendet werden!</h1>";

        &http_end;

        exit;

}

 

#-------------

# Ausgabe

&http_header;

 

#-------------

# Test, ob Verzeichnis erlaubt

$tmp = $dir.'/'."\.noaccess";

if( -f $tmp ) {

        print  "</table><h2>Sicherheits-Einschr&auml;nkung:</h2>\n

                <hr noshade><p>

                Es besteht keine Berechtigung, das Verzeichnis

                $urldir zu lesen.<p>";

        &http_end;

        exit;

}

 

#-------------

# Tabellenkopf

print $q->h1( "Verzeichnisinhalt: $urldir" );

print  "<hr noshade>\n";

#print  "<table border cellpadding=5>\n

print  "<table cellpading=8>\n

        <tr>\n

        <td colspan=2><b>Name:</b>

        <td><b>Datum:</b>

        <td><b>Typ:</b>

        <td><b>Inhalt:</b>

        </tr>";

 

#-------------

# 1.Zeile: Ein Verzeichnis hoeher, wenn moeglich

if( $urldir gt "/" ) {

        $parentdir = $urldir;

        $parentdir =~ s/[\w-\.]+\/*$//;

        print  "<tr><td><img src='/icons/back.gif'>

                <td colspan=3>

                <a href=\"$scripturl$parentdir\">

                Verzeichnisebene h&ouml;her</a></td></tr>";

}

 

#-------------

# Verzeichnis oeffnen

unless ( opendir DIR, $dir ) {

        print  "</table><h2>Fataler interner Fehler:</h2>\n

                Bitte teilen Sie folgenden Fehler Ihrem

                Systemadministrator mit:\n

                Konnte Verzeichnis nicht &ouml;ffnen: <ul>

                <ul><li> Dir: $dir

                <li>UrlDir: $urldir

                <li>ParentDir: $parentdir</ul>

                </body></html>";

                exit;

}

 

#-------------

# Verzeichniseintraege lesen

while ($filename = readdir DIR) {

        next if $filename =~ /^\./;     # keine dotted files !

        next if $filename =~ /\~$/;     # keine Backups

        next if $filename =~ /\.bak/i;  # keine alten Dateien

 

        &datei_eintrag( $filename );

}

closedir DIR;

 

#-------------

# Abschlussarbeiten

print  "</table>\n";

#&env_test;             # Debug-Information: verwendete (Umgebungs-) Variablen

&http_end;

exit( 0 );

 

#----------------------------------------

# HTTP-Header ausgeben

sub http_header {

        my( $s );

        $s = "Verzeichnisinhalt: $urldir";

        print $q->header;

        print $q->start_html(   -title=>$s,

                                -author=>'cmetten@intern.fh-regensburg.de');

}

 

#----------------------------------------

# Der Rest vom Schuetzenfest

sub http_end {

        print  "<hr noshade>\n

                <font size=-1>

                <a href=\"http://INTERN-fh-regensburg.de/~cmetten\">

                Christoph Metten</a>, ";

        print  `date`;

 

        print $q->end_html;

}

 

#----------------------------------------

# Debugging-Routine: Ausgabe aller verwendeten Variablen

sub env_test {

        print  "<hr noshade><p>

                <h3>Scriptvariablen:</h3>

                <table> 

                <tr><td>WWW-url<td>$wwwurl

                <tr><td>Dir<td>$dir</tr>

                <tr><td>UrlDir<td>$urldir</tr>

                <tr><td>ParentDir<td>$parentdir</tr>

                <tr><td>ScriptUrl<td>$scripturl</tr>

                <tr><td>ServerName<td>$ENV{'SERVER_NAME'}</tr>

                <tr><td>ServerPort<td>$ENV{'SERVER_PORT'}</tr>

                <tr><td>ScriptName<td>$ENV{'SCRIPT_NAME'}</tr>

                <tr><td>PathTranslated<td>$ENV{'PATH_TRANSLATED'}</tr>

                <tr><td>PathInfo<td>$ENV{'PATH_INFO'}</tr>

                <tr><td>DocumentRoot<td>$ENV{'DOCUMENT_ROOT'}</tr>

                </table>";

}

 

#----------------------------------------

# Dateieintrag lesen und ausgeben

sub datei_eintrag {

        my( @stat, $fn, $url, $pfn, $mtime, $img, $typ, $rem );

 

        $fn = $_[0];

        $url = $urldir;

        if( chop($url) ne "/" ) { $url = $urldir; }

        $pfn = $dir.'/'.$fn;

        @stat = stat $dir.'/'.$fn;

        $mtime = localtime($stat[9]);

        $mtime =~ s/^... //;

        $mtime =~ s/:\d\d\s+\d\d\d\d//;

        $rem = "";

 

        if( -d $pfn ) {                         # Verzeichniseintrag

                $img = 'dir.gif';

                $typ = 'Verzeichnis';

                print  "<tr>

                        <td><img border=0 src='/icons/$img'>

                        <td><a href=\"$scripturl$url/$fn\">$fn</a>

                        <td>$mtime

                        <td>$typ

                        </tr>\n";

        } else {

                if( $fn =~ /\.html?$/i ) {      # HTML-Dokumente

                        $img = 'layout.gif';

                        $typ = 'HTML-Dokument';

                        open(DATEI, $pfn) || die "Kann Datei nicht oeffnen";

                        while( <DATEI> ) {

                                if( /<title>/i ) {

                                        s/^.*<title>(.*)/\1/i;

                                        s/<\/title>.*$//i;

                                        $rem = $_;

                                        chop( $rem );

                                        last;

                                }

                        }

                        close DAT;

                } elsif( $fn =~ /\.cgi/i ) {    # CGI-dateien

                        $img = 'p.gif';

                        $typ = 'CGI-Programm';

                } elsif( $fn =~ /\.txt/i ) {    # Text-dateien

                        $img = 'text.gif';

                        $typ = 'Text-Dokument';

                } elsif( $fn =~ /\.doc/i ) {    # Word-Dokumente

                        $img = 'bomb.gif';

                        $typ = 'Word-Dokument';

                } else {                        # alles andere

                        $img = 'unknown.gif';

                        $typ = 'unbekannter Typ';

                }

        

                print  "<tr>

                        <td><img border=0 src='/icons/$img'>

                        <td><a href=\"$wwwurl$url/$fn\">$fn</a>

                        <td>$mtime

                        <td>$typ

                        <td><i>$rem</i>

                        </tr>\n";

        }

}

#--E-O-F------------------------------------