Webenv: Perl und Webinfos
Dieses Skript ist eine Erweiterung des Environment-Skriptes.
Es zeigt jedoch mehr Informationen an und dient im wesentlichen der Schnellübersicht
für die CGI-Programmierer auf einem Server über installierte Perlmodule,
Pfade etc.
Das Skript läßt sich dabei aufg Wunsch per SSI einbinden und gibt auch
vorhandene Anleitungen von Perlmodule, sowie derren Versionsnummern aus.
Source Code
| Perl Sourcecode | |
| webenv.pl | Das Skript webenv.pl (V1.10) |
| Achtung: Sollte beim obigen Download-Link fehlerhafterweise als Dateiname "xload.cgi" angegeben sein, ignorieren Sie dies und benennen den Dateinamen um. Einige Browser ignorieren leider den Standard zur Übermittlung von Dateinamen... | |
Wirkungsweise
Das Skript kann sowohl als SSI eingebunden werden, als auch über einen Direktlink.
Beispielaufruf via SSI: (Hier nur mit Angabe der Perlinfo)
#! /usr/bin/perl
##############################################################################
# $Id: webenv.pl,v 1.1 2003/05/23 07:34:37 xwolf Exp $ #
# COPYRIGHT NOTICE #
# Copyright 2001 Wolfgang Wiese All Rights Reserved. #
# EMail: xwolf@xwolf.com #
# URL : http://www.xwolf.com #
# #
# This script may be used and modified free of charge by anyone so long as #
# this copyright notice and the comments above remain intact. By using this #
# code you agree to indemnify Wolfgang Wiese from any liability that #
# might arise from it's use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact.#
##############################################################################
# Last Modified on: $Date: 2003/05/23 07:34:37 $
# By: $Author: xwolf $
# Version: $Revision: 1.1 $
##############################################################################
use File::Find;
use strict;
my $WHEREIS_PROG = "/usr/bin/whereis";
# Absolute Pfadangabe zum programm 'whereis'
my $sendmail = `$WHEREIS_PROG sendmail`;
# Pfad zu sendmail
my $DISPLAY_PERL_INFO = 1;
# Sollen die allgmeinen Perlinfos ausgegeben werden (1)
my $DISPLAY_PERL_MODULE = 1;
# Sollen alle perlmodule angezeigt werden (1)
my $PERLDOC_PROG = "/usr/bin/perldoc";
# Pfad zum Programm perldoc
my $MODI_DISPLAY_BY_WEB = 1;
# Ist dieser Wert ungleich 0 darf man die folgenden
# Settings $DISPLAY_MODUL_DOCURL, $DISPLAY_ENVIRONMENT, $DISPLAY_ENVIRONMENT
# und $DISPLAY_USERINFO uebers Web aendern und gezeilt durch die
# Webparameter 'userinfo', 'environment', 'perlinfo' und 'perlmodule'
# schalten.
# Bsp 1: /cgi-bin/webenv.pl?perlmodule=1
# Bsp 2: /cgi-bin/webenv.pl?perlmodule=1&environment=1
my $DISPLAY_MODUL_DOCURL = 1;
# Sollen die Links zu den Perldocs bei den Modulen angezeigt werden (1)
my $DISPLAY_ENVIRONMENT = 1;
# Soll das Environment angezeigt werden... (1)
my $DISPLAY_USERINFO = 0;
# userinfo anzeigen (1)
my $CELLS = 3;
# Anzeige der Modulliste: Anzahl der Module pro Zeile
my $SWITCH_COLOR_A = "#ffffff";
# Anzeige: Wechselfarbe 1
my $SWITCH_COLOR_B = "#ccccff";
# Anzeige: Wechselfarbe 2
my $TABLE_HEADER_BACKGROUND = "#9999cc";
# Anzeige: Background fuer Ueberschrift-Tabellenzelle
my $DOUBLESWITCH = 0;
# Anzeige der Modulliste: Sollen die Fraben der Zellen
# pro Spalten wechseln (0) oder pro Eintrag (1).
################################################################################
# Weitere Aufrufoption (nuetzlich fuer SSI-Aufrufe):
# /cgi-bin/webenv.pl?delhead=1 : sorgt dafuer das keine HTML-Head
# Tags ausgegeben werden
# deltitle=1 : sorgt dafuer, dass der Titel und das Menu
# verschwindet
################################################################################
# Main program after this point. Don't change
################################################################################
my %in = &ReadParse;
# Einlesen von uebergebenen Parametern
my %MODUL;
# Wird fuer die Module benoetigt
print "Content-type: text/html\n\n";
if (not $in{'delhead'}) {
print "\n";
print "WebEnv - Perl und Web-Informationen \n";
print "\n";
print "\n";
}
my @NEWINC = &RemoveClones;
if (($in{'userinfo'} || $in{'environment'} || $in{'perlinfo'} || $in{'perlmodule'}) && ($MODI_DISPLAY_BY_WEB)) {
$DISPLAY_USERINFO = $in{'userinfo'};
$DISPLAY_ENVIRONMENT = $in{'environment'};
$DISPLAY_PERL_INFO = $in{'perlinfo'};
$DISPLAY_PERL_MODULE = $in{'perlmodule'};
}
if (not $in{'deltitle'}) {
print "
\n"; } if ($in{'action'}) { if ($in{'action'} =~ /perldoc/) { &DisplayPerlDoc($in{'doc'}); } } else { if ($DISPLAY_USERINFO) { print "\n"; &DisplayUserInfo; print "
\n"; } if ($DISPLAY_ENVIRONMENT) { print "\n"; &DisplayEnvironment; print "
\n"; } if ($DISPLAY_PERL_INFO) { print "\n"; &GeneratePerlInfo; print "
\n"; } if ($DISPLAY_PERL_MODULE) { print "\n"; &GeneratePerlModulliste; print "
\n"; } } if (not $in{'delhead'}) { print "\n";
print "
\n";
}
################################################################################
sub DisplayEnvironment {
my $key;
my $switch;
print "\n";
print "
\n";
}
################################################################################
sub DisplayPerlDoc {
my $name = shift;
my $oldname = $name;
my $doku;
if (not $name) {
print "\n";
print "Sie gaben eine ungueltige Zeichenkette für die Anzeige an.
\n"; return; } $name =~ s/[^a-zA-Z0-9:\-_]+//gi; if ($name ne $oldname) { print "\n"; print "Sie gaben eine ungueltige Zeichenkette für die Anzeige an.
\n"; print "Beachten Sie, daß alle Zugriffe geloggt werden.
\n"; } else { $doku = `$PERLDOC_PROG -t $name`; print "\n";
print "
\n";
}
}
################################################################################
sub RemoveClones {
my @liste = @_ || @INC;
my @result;
my $i;
my %hash;
my $key;
for ($i=0; $i<=$#liste; $i++) {
if (not $hash{$liste[$i]}) {
$hash{$liste[$i]} =1;
}
}
foreach $key (keys %hash) {
next if ($key eq ".");
push(@result, $key);
}
@result = sort @result;
return @result;
}
################################################################################
sub GeneratePerlInfo {
my $perllok = `$WHEREIS_PROG perl5`;
my @perlort = split(/[\s\n\r]+/,$perllok);
my $i;
print "\n";
print "
\n";
}
################################################################################
sub GeneratePerlModulliste {
my $insert;
my $i;
my $key;
my $count =1;
my $switch;
find(\&module, @NEWINC);
print "\n";
print "
\n";
}
################################################################################
sub module {
my $name = $_;
my $packagename;
my $version;
my $pinfo;
my $vinfo;
my $packageversion;
my $line;
if ($name =~ /\.pm$/) {
open(MOD,$name) || return;
while() {
$line = $_;
if ($line =~ /^ *package +(\S+);/) {
$packagename = $1;
$pinfo=1;
}
if ($line =~ /\$Id: ([a-zA-Z0-9\-_\.]+),v ([0-9\.]+) /) {
# $packagename = $1;
$version = $2;
# $pinfo=1;
$vinfo++;
}
if (($packagename) && (not $vinfo)) {
$packageversion = $packagename."::VERSION";
}
if (not $vinfo) {
if ($line =~ /^\s*\$VERSION\s*=\s*(?:["\'\s]?)([0-9\.]+)(?:["\'\s]?);\s*$/) {
$version = $1;
$vinfo++;
}
if ($line =~ /Revision: ([0-9\.]+) \$/) {
$version = $1;
$vinfo++;
}
if ($line =~ /$packageversion\s*=\s*(?:["\'\s]?)([0-9\.]+)(?:["\'\s]?)/) {
$version = $1;
$vinfo++;
}
}
if (($pinfo) && ($vinfo)) {
last;
}
}
close MOD;
if (($packagename) && (($MODUL{$packagename} eq "??") || (not $MODUL{$packagename})) ) {
if ($version) {
$MODUL{$packagename} = $version;
} else {
$MODUL{$packagename} = "??";
}
}
}
}
##############################################################################
sub ReadParse {
my $buffer;
my ($namebuffer,$valuebuffer);
my %result;
my $pair;
my @nvpairs;
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$buffer = $ENV{'QUERY_STRING'};
} else {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
if (not $buffer) {
$buffer=substr($ENV{'PATH_INFO'},1,length($ENV{'PATH_INFO'}));
}
if (not $buffer) {
$buffer=@ARGV;
}
@nvpairs = split(/&/,$buffer);
foreach $pair (@nvpairs) {
($namebuffer, $valuebuffer) = split(/=/, $pair);
$valuebuffer =~ tr/+/ /;
$valuebuffer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if (exists($result{$namebuffer})) {
$result{$namebuffer} .= ", $valuebuffer";
} else {
$result{$namebuffer}=$valuebuffer;
}
}
return %result;
}
################################################################################
# EOF
################################################################################
WebEnv - Perl und Web-Informationen
\n"; if ($DISPLAY_USERINFO) { print " [Skriptuser] "; } if ($DISPLAY_ENVIRONMENT) { print " [Environment] "; } if ($DISPLAY_PERL_INFO) { print " [Perl-Settings] "; } if ($DISPLAY_PERL_MODULE) { print " [Perl-Module] "; } print "\n"; } if ($in{'action'}) { if ($in{'action'} =~ /perldoc/) { &DisplayPerlDoc($in{'doc'}); } } else { if ($DISPLAY_USERINFO) { print "\n"; &DisplayUserInfo; print "
\n"; } if ($DISPLAY_ENVIRONMENT) { print "\n"; &DisplayEnvironment; print "
\n"; } if ($DISPLAY_PERL_INFO) { print "\n"; &GeneratePerlInfo; print "
\n"; } if ($DISPLAY_PERL_MODULE) { print "\n"; &GeneratePerlModulliste; print "
\n"; } } if (not $in{'delhead'}) { print "
Skript by xwolf
\n";
print "\n\n";
}
exit;
################################################################################
# Subroutines
################################################################################
sub DisplayUserInfo {
my $user = getpwuid($<);
my $group = getgrgid($();
print "\n";
print "
| ||||||
\n";
print "
| ||||
\n"; return; } $name =~ s/[^a-zA-Z0-9:\-_]+//gi; if ($name ne $oldname) { print "\n"; print "Sie gaben eine ungueltige Zeichenkette für die Anzeige an.
\n"; print "Beachten Sie, daß alle Zugriffe geloggt werden.
\n"; } else { $doku = `$PERLDOC_PROG -t $name`; print "
\n";
print "
|
\n";
print "
| ||||||||||
\n";
print "
|
Beispielaufruf als Link:
Installation
Kopieren Sie die Datei webenv.pl in Ihr CGI-BIN-Verzeichnis. Setzen Sie die Ausführungsrechte
mittels CHMOD. Z.B.: chmod 755 webenv.pl.
Ändern Sie im Programm webenv.pl bei Bedarf folgende Zeilen:
Zeile 1: #!/usr/bin/perl |
Geben Sie hier Ihren eigenen Pfad zu Perl ein, falls er von diesem abweicht. |
Zeile 28: my $WHEREIS_PROG = "/usr/bin/whereis"; |
Geben Sie hier den Pfad zum Programm "whereis" ein. Sollte er von dem vorgegebenen Pfad abweichen und Sie ihn kennen, fragen Sie den Systemadministrator. |
Zeile 36: my $PERLDOC_PROG = "/usr/bin/perldoc"; |
Geben Sie hier den Pfad zum Programm "perldoc" ein. Sollte er von dem vorgegebenen Pfad abweichen und Sie ihn kennen, fragen Sie den Systemadministrator. Dieses Programm sollte normalerweise zusammen mit Perl auf dem System vorhanden sein. |
Alle anderen Parameter im Programm, die Sie in den Zeilen 28 bis 60 ändern können dienen lediglich der Art der Anzeige. Die Paramater und derren Funktionen sind im Programm kommentiert.
Info
$Id: webenv.shtml,v 1.3 2003/05/22 13:48:00 xwolf Exp $, Linkcount: [an error occurred while processing this directive]
© 1996 - 2003 by xwolf -
xwolf ist eingetragene Marke beim Deutschen Patent- und Markenamt (Nr. 301 04 380)