#!/sw/mnm/perl5/bin/perl
#######################################################################
# Diese Datei enthaelt das Programm LinkTest zum testen der Konsistenz
# von WWW-Links.
# Zu Beginn der Datei steht das Hauptprogramm.
# An diese schliessen sich folgende Funktionen an:
# NeueLinksaufnehmen : Nimmt die von HoleLinksZuEinerSeite gef. Links in einen
# Array auf
# HoleLinksZuEinerSeite: Gibt alle Links auf einer angegebenen Seite zurueck
# HoleKopf : Testet das Vorhandensein eines Dokuments
# VerschickeBeiFehler : Fuer fehlerhafte Links wird ein Mail verschickt
# FehlerLogAbarbeiten : Laeuft durch die Fehler-Log-Datei und uebergibt den
# Fehlercode FehlerBearbeiten
# FehlerBearbeiten : Gibt String mit Fehlererklaerung zurueck
#
# Fuer den Ablauf wird die Datei LinkTest.ini benoetigt. Von ihr wird der Ablauf des
# Programms gesteuert. Das Programm erzeugt in jedem Fall folgende Dateien:
# LinkTest.ERR.log : Datei mit den gefundenen fehlerhaften Links
# LinkTest.ERL.log : Datei mit den erfolgreich abgearbeiteten Links
# LinkTest.NEU.log : Datei mit den noch nicht bearbeiteten Links (infolge
# der Angabe MaxAnzahlLinks)
# LinkTest.log : Datei mit den durchgefuehrten HTTP-Anfragen
# Ausserdem werden abhaenigig von der Einstellung NACHRICHT in der LinkTest.ini
# Datei folgende Dateien erstellt:
# LinkTest.NachrichtBetreuer : Text, der an den Betreuer einer Seite geschickt
# wuerde.
# LinkTest.NachrichtBoss : Text, der an den Gesamtverantwortlichen geschickt
# wuerde.
#
# Als zentrale Datenstruktur wird ein sog. Assoziativer Array benutzt. In solchen
# Arrays werden saemtliche relevanten Daten als String abgelegt.
# Als Schluesselelement dafuer dient der absolute Pfad mit Domaine.
# Die Elemente des Arrays sind Strings mit folgendem Format:
# LinkMethode;Vaeter;Betreuer;LinkTyp
# - LinkMethode gibt an, welche Methode fuer den Zugriff zu benutzen ist
# (z.B. HTTP,FTP,MAILTO,...)
# - Vaeter gibt alle Vaeter zu einer Seite innerhalb der durchsuchten Domaine an.
# Diese sind dann durch | getrennt. Dabei ist bei jedem Vater der
# absolute Pfad mit Domaine plus die Zeile, in der der Sohn-Link
# steht durch :Z getrennt angegeben.
# - Hier steht die Mailadresse des ermittelten Betreuers
# - Hier steht, in welchem Zusammenhang auf das Dokument zugegriffen wird
# (A,IMG,SRC,LINK)
######################################################################
# Lesen der Initialisierungsdatei, wie sie in der Kommandozeile als
# erstes Argument angegeben wurde. Bei keiner Angabe nimm LinkTest.ini
if ($ARGV[0])
{
$IniDatei = $ARGV[0];
$ProgPfad = substr($IniDatei,0,rindex($IniDatei,"/"));
print "$ProgPfad\n";
chdir($ProgPfad);
}
else
{
$IniDatei = 'LinkTest.ini'; # Defaultwert
}
if(!open(INIDATEI,$IniDatei))
{
die "\nKonnte Initialisierungsdatei $IniDatei nicht oeffnen!\n";
}
#######################################################################
# Parsen der Ini-Datei und setzen der entsprechenden Variablen
while(<INIDATEI>)
{
if (/^((\s*#)|(\s+))/) # Falls Kommentar- oder Leerzeile:
{
next; # ueberspringen
}
elsif (/\[WWW_SERVER\]=/) # Domainen, die kontrolliert werden sollen
{ # zu einem Regulaeren Ausdruck zusammensetzen
/=(.*?);/;
$HilfsVar = $1;
$httpserver = '($Domain eq "'.join('") || ($Domain eq "',
split(/,/,$HilfsVar)).'")';
$HilfsVar=~/(.*?),/;
$Domain = $1;
}
elsif (/\[TOP_LINK\]=/)
{
/=(.*?);/;
$TopLink = "$1";
}
elsif (/\[ENDUNGEN\]=/) # Endungen bei denen nur der Kopf benoetigt wird
{ # zu einem Regulaeren Ausdruck zusammensetzen
/=(.*?);/;
$Endungen = '($1 eq '.join(') || ($1 eq ',split(/,/,$1)).')';
}
elsif (/\[MAX_LINKS\]=/)
{
/=(.*?);/;
$MaxLinks = "$1";
}
elsif (/\[BETREUER_TAG\]=/)
{
/=(.*?);/;
$RegBetreuerTag = $1;
}
elsif (/\[BETREUER_ADRESSE\]=/)
{
/=(.*?);/;
$RegBetreuerAdresse = $1;
}
elsif (/\[NACHRICHT\]=KEINE/)
{
/=(.*?);/;
$Nachricht = $1;
}
}
close(INIDATEI);
$Datum = `date`; # Datum und Zeit des Startes sichern
# Initialisiere assoz. Array mit erstem Link
$LinksNEU{"$Domain$TopLink"}=join(";","HTTP","TOP:Z0","TOP","TOP");
# Oeffne Log-Datei fuer die Sitzung
open(LOG,">LinkTest.LOG");
print LOG "Prueflauf vom $Datum\n";
# Nimm, solange es einen Eintrag gibt, das erste Element aus dem Neuenarray
# Achte dabei darauf, dass nicht mehr Aufrufe als gewuenscht behandelt werden.
while ( ($DomainLink=(keys(%LinksNEU))[0]) && ($Aufrufe < $MaxLinks))
{
$Aufrufe++; # Anzahl der Aufrufe mitzaehlen.
$Domain = substr($DomainLink,0,index($DomainLink,"/"));
$Link = substr($DomainLink,index($DomainLink,"/"));
# Beschreibung aus Array holen
$Beschreibung = $LinksNEU{"$DomainLink"};
#####################################################################
# Liefere eine Liste von Links auf der Seite mit Betreuer zur Seite oder
# Fehler. Je nach Endung nur Kopf oder ganzes Dokument laden
$Link=~/\/.*\.(.*)$/; # Endung des Links herausholen
if (eval ($Endungen) || !eval($httpserver) ) # Mit Endungen und Servern in
# der Initialisierungsdatei vgl.
{ # Falls Kopf reicht
print "$Aufrufe\tSende HEAD //$Domain$Link\n";# Aufruf anzeigen
print LOG "Sende HEAD //$Domain$Link\n";# Aufruf mitloggen
%NeueLinks = &HoleKopf($Link,$Domain);
}
else
{ # Falls Seite noetig mit Linkkontrolle
print "$Aufrufe\tSende GET //$Domain$Link\n";# Aufruf anzeigen
print LOG "Sende GET //$Domain$Link\n";# Aufruf mitloggen
%NeueLinks = &HoleLinksZuEinerSeite($Link,$Domain,$RegBetreuerTag,
$RegBetreuerAdresse);
}
####################################################################################
# Den Link, den man ueberprueft hat erledigen,das heisst bei einem Fehler in Fehler-
# array speichern, ansonsten den ermittelten Betreuer dazuspeichern und in den Er-
# ledigtarray ablegen. Fehler und Betreuer werden in dem Feld "FEHLER" bzw. "BETREUER"
# des Arrays uebergeben. Sie sind anschliessend zu loeschen.
if($NeueLinks{"FEHLER"}) # Tauchte bei zu pruefendem Link ein Fehler auf ?
{
# Beschreibung aufsplitten
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Beschreibung);
$Betreuer=$NeueLinks{"FEHLER"}; # ins Betreuerfeld den Fehlercode
# Beschreibung in ErrorArray speichern
$LinksERR{"$DomainLink"}=join(";",$LinkMethode,$Vaeter,$Betreuer,$LinkTyp);
}
else
{
# Beschreibung aufsplitten
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Beschreibung);
$Betreuer=$NeueLinks{"BETREUER"};
# Beschreibung mit jeweiligem Betreuer speichern
$LinksERL{"$DomainLink"}=join(";",$LinkMethode,$Vaeter,$Betreuer,$LinkTyp);
delete $NeueLinks{"BETREUER"}; # Da dies reines Uebergabefeld war, loeschen.
&NeueLinksaufnehmen;
}
delete $LinksNEU{$DomainLink};
}
close(LOG); # Logfile schliessen
######################################################################
# Statistik - Ausgabe
open (LOGERR,">LinkTest.ERR.LOG");
print LOGERR "################################################################\n";
print LOGERR "# Log-Datei zum Programm LinkTest (testen von Links auf einem WWW-Server)\n";
print LOGERR "# vom $Datum .\n";
print LOGERR "# HIER: LINKS, AUF DIE NICHT ZUGEGRIIFEN WERDEN KONNTE:\n";
print LOGERR "################################################################\n";
while(($Marke,$Wert)= each(%LinksERR))
{
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Wert);
print LOGERR "Url : $LinkMethode://$Marke\n";
print LOGERR "Vater : ",join("\n ",split(/\|/,$Vaeter)),"\n";
print LOGERR "Fehler : $Betreuer\n";
print LOGERR "Intern --: $Marke;$Wert\n";
}
close (LOGERR);
open (LOGNEU,">LinkTest.NEU.LOG");
print LOGNEU "################################################################\n";
print LOGNEU "# Log-Datei zum Programm LinkTest (testen von Links auf einem WWW-Server)\n";
print LOGNEU "# vom $Datum .\n";
print LOGNEU "# HIER: LINKS, DIE IN DIESEM LAUF NOCH NICHT GETESTET WURDEN,\n";
print LOGNEU "# AUF DIE ABER ZUGEGRIFFEN WIRD:\n";
print LOGNEU "################################################################\n";
while(($Marke,$Wert)= each(%LinksNEU))
{
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Wert);
print LOGNEU "Url : $LinkMethode://$Marke\n";
print LOGNEU "Vater : ",join("\n ",split(/\|/,$Vaeter)),"\n";
print LOGNEU "Intern --: $Marke;$Wert\n\n";
}
close (LOGNEU);
open (LOGERL,">LinkTest.ERL.LOG");
print LOGERL "################################################################\n";
print LOGERL "# Log-Datei zum Programm LinkTest (testen von Links auf einem WWW-Server)\n";
print LOGERL "# vom $Datum .\n";
print LOGERL "# HIER: LINKS, AUF DIE MIT ERFOLG (OHNE FEHLER) ZUGEGRIFFEN WERDEN\n";
print LOGERL "# KONNTE:\n";
print LOGERL "################################################################\n";
while(($Marke,$Wert)= each(%LinksERL))
{
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Wert);
print LOGERL "Url : $LinkMethode://$Marke\n";
print LOGERL "Vater : ",join("\n ",split(/\|/,$Vaeter)),"\n";
print LOGERL "Betreuer : $Betreuer\n";
print LOGERL "Intern --: $Marke;$Wert\n\n";
}
close (LOGERL);
$Anzahl = keys(%LinksERL);
print "Anzahl erledigte Links ohne Fehler: $Anzahl\n";
$Anzahl = keys(%LinksERR);
print "Anzahl fehlerhafte Links: $Anzahl\n";
######################################################################
# Mail-Aufruf falls gewuenscht
if (!($Nachricht eq "KEINE"))
{
&VerschickeBeiFehler($IniDatei,%LinksERL,%LinksERR);
}
######################################################################
# Hinweis auf Hilfsprogramm zur Fehleransicht.
print "Mit \"LinkTest.FehlerList\" koennen Sie sich eine ausfuehrliche Liste \n
der aufgetretenen Fehler anzeigen lassen\n";
print "Mit \"LinkTest.BaumErstellen\" koennen Sie die Struktur des geprueften \n
Bereichs als Baum ausgeben.\n";
###################################################################################
# ENDE Hauptprogramm
###################################################################################
#####################################################################################
#
# Unterprogramm NeueLinksaufnehmen
#
#####################################################################################
# Gefundene Links , falls noch nicht schon wo vorhanden, in den Neuenarray aufnehmen
sub NeueLinksaufnehmen
{
# Nimm neue Links in Liste auf
foreach $NeuerDomainLink (keys(%NeueLinks))
{
# Beschreibung vom vermeintlich neuen Link aufsplitten
($LinkMethode,$NeuerVater) = split(/;/,$NeueLinks{"$NeuerDomainLink"});
######################################################################
# Pruefe ob Link schon im Neuenarray vorhanden
if ($LinksNEU{$NeuerDomainLink})
{ # Wenn vorhanden:
# Alte Beschreibung aufsplitten
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,
$LinksNEU{"$NeuerDomainLink"});
# Vaeter erweitern (sind sicher nicht doppelt,
# da aus Unterprog nur einfach hochgereicht)
$Vaeter = join("|", ($Vaeter,$NeuerVater));
# $Beschreibung wieder zusammenbauen und in Liste ablegen
$LinksNEU{"$NeuerDomainLink"}=join(";",($LinkMethode,$Vaeter,
$Betreuer,$LinkTyp));
next; # Naechsten neuen Link
}
######################################################################
# Pruefe ob Link schon im Erledigtenarray vorhanden
elsif ($LinksERL{$NeuerDomainLink})
{ # Wenn vorhanden:
# Alte Beschreibung aufsplitten
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,
$LinksERL{"$NeuerDomainLink"});
# Vaeter erweitern (sind sicher nicht doppelt,
# da aus Unterprog nur einfach hochgereicht)
$Vaeter = join("|", ($Vaeter,$NeuerVater));
# $Beschreibung wieder zusammenbauen und in Liste ablegen
$LinksERL{"$NeuerDomainLink"}=join(";",($LinkMethode,$Vaeter,
$Betreuer,$LinkTyp));
next; # Naechsten neuen Link
}
#######################################################################
# Pruefe ob Link schon im Fehlerarray vorhanden
elsif ($LinksERR{$NeuerDomainLink})
{ # Wenn vorhanden:
# Alte Beschreibung aufsplitten
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,
$LinksERR{"$NeuerDomainLink"});
# Vaeter erweitern (sind sicher nicht doppelt,
# da aus Unterprog nur einfach hochgereicht)
$Vaeter = join("|", ($Vaeter,$NeuerVater));
# $Beschreibung wieder zusammenbauen und in Liste ablegen
$LinksERR{"$NeuerDomainLink"}=join(";",($LinkMethode,$Vaeter,
$Betreuer,$LinkTyp));
next; # Naechsten neuen Link
}
else ########################################################
{ # Wenn Link noch nirgends vorhanden
if ($LinkMethode eq "HTTP")
{ # Falls ein HTTP-Link, nimm ihn in Neuenarray auf
$LinksNEU{$NeuerDomainLink} = $NeueLinks{$NeuerDomainLink};
}
else
{ # Falls andere Methode, nimm ihn in Erledigtenarray auf
$LinksERL{$NeuerDomainLink} = $NeueLinks{$NeuerDomainLink};
}
}
}
}
##################################################################
#
# Unterprogramm HoleLinksZuEinerSeite
#
##################################################################
sub HoleLinksZuEinerSeite
{
# Uebernahme der Parameter
local($Url,$DomainPort,$RegBetreuerTag,$RegBetreuerAdresse) = @_ ;
# Definition von lokalen Variablen
local($Pfad,$Link,$LinkTyp,$LinkMethode,$Seite,@Marken,%Links);
# Pfad abspalten und merken, um ihn bei relativen Links anfuegen zu koennen
$Pfad = substr($Url,0,rindex($Url,"/")+1);
#####################################################################
# Port fuer die Kommunikation abspalten, falls angegeben. Wenn nicht,
# mit 80 vorbesetzen.
if ( $DomainPort=~/:/)
{
$Stelle = rindex($DomainPort,":");
$HttpPort = substr($DomainPort,$Stelle+1);
$Domain = substr($DomainPort,0,$Stelle);
}
else
{
$HttpPort = 80;
}
###########################
# Parameter fuer den Socket
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';
# Name des Rechners, von dem aus geprueft wird ermitteln
$hostname = `hostname`;
# Servername fuer die Anbindung aufbereiten
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$HttpPort) = getservbyname($HttpPort,'tcp')
unless $HttpPort =~ /^\d+$/;
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
# Gegenadresse auf gewuenschte Domaine setzen
($name, $aliases, $type, $len, $thataddr) = gethostbyname($Domain);
$that = pack($sockaddr, $AF_INET, $HttpPort, $thataddr);
# Create a handle to the socket
if (!socket(HTTP_Anschluss, $AF_INET, $SOCK_STREAM, $proto))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=600; # Socket failed
return %Links ;
}
# Assign the socket an address
if (!bind(HTTP_Anschluss, $this))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=601; # Bind failed
return %Links ;
}
# an den Server connect'en
if (!connect(HTTP_Anschluss,$that))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=602; # Connect failed
return %Links ;
}
select(HTTP_Anschluss); # Anschluss HTTP_Anschluss anwaehlen
$| = 1; # Anschluss auf NICHT PUFFERN stellen
select(STDOUT); # Anschluss STDOUT anwaehlen
$| = 1; # Anschluss auf NICHT PUFFERN stellen
# $/ = ""; # in einem Stueck einlesen
$* = 1; # ungleich 0 => Patternsuche ueber mehrere Zeilen
# Den Server um die Seite $Url bitten
print HTTP_Anschluss "GET $Url HTTP/1.0\n\n";
##############################################
# Seite vom Server uebernehmen
while (<HTTP_Anschluss>)
{
$Seite = join(" <Z$.Z> ",($Seite,$_));
}
close HTTP_Anschluss;
if (!$Seite)
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=603; # Leere Seite
return %Links ;
}
$_ = substr($Seite,16); # In Perl's Allzweckvariable stecken
##############################################
# Auf Fehlermeldungen des Servers ueberpruefen
if (/^([4,5]\d\d)/)
{
$Links{"FEHLER"}=$1;
return %Links ;
}
##############################################
# Seite weiterbearbeiten
s/\n/ /g; # New Line loeschen
s/^.*?</</; # Bis zum ersten Tag alles loeschen
s/>.*?</>;</g; # Nur Tags behalten,durch Strichpunkt getrennt
s/#.*?(["\s])/$1/g; # Directives in der Seite loeschen
@Marken = split(/;/); # Array @Marken mit den Tags fuellen
foreach (@Marken) # jede Marke ueberpruefen:
{
if (/<Z(\d*?)Z>/) # Zeilennummer merken
{
$Zeile = $1;
next;
}
########################################
# Betreuer heraussichern
if (/$RegBetreuerTag/i) # falls Betreuer
{
/$RegBetreuerAdresse/i; # URI suchen, in $1 ablegen
$Link = join("",($1,$2)); # Fund mit oder ohne " $Link zuweisen
$Links{"BETREUER"} = $Link ; # Betreuer sichern
next;
}
########################################
# Links herausarbeiten
if (/<IMG /i) # falls Image
{
/SRC="(.*?)"|SRC=(.*?)[\s>]/i; # URI suchen, in $1 ablegen
$Link = join("",($1,$2)); # Fund mit oder ohne " $Link zuweisen
$LinkTyp = "IMG"; # Link-Typ in dem der Link vorkommt sichern
}
elsif (/<A /i) # falls Anker
{
/HREF="(.*?)"|HREF=(.*?)[\s>]/i; # URI suchen, in $1 ablegen
$Link = join("",($1,$2)); # Fund mit oder ohne " $Link zuweisen
$LinkTyp = "A"; # Link-Typ in dem der Link vorkommt sichern
}
elsif (/<LINK /i) # falls Link
{
/HREF="(.*?)"|HREF=(.*?)[\s>]/i; # URI suchen, in $1 ablegen
$Link = join("",($1,$2)); # Fund mit oder ohne " $Link zuweisen
$LinkTyp = "LINK"; # Link-Typ in dem der Link vorkommt sichern
}
elsif (/<INPUT /i) # falls Input
{
/SRC="(.*?)"|SRC=(.*?)[\s>]/i; # URI suchen, in $1 ablegen
$Link = join("",($1,$2)); # Fund mit oder ohne " $Link zuweisen
$LinkTyp = "INPUT"; # Link-Typ in dem der Link vorkommt sichern
}
else # falls nichts von alledem,
{
next; # ueberpruefe naechste Marke
}
#######################################
# Link gefunden, also weiterverarbeiten
if ($Link) # Link ist nicht leer?
{
###############################################
# Methoden abspalten
if ($Link=~s/http://) # Methode http? (wenn ja http: weg)
{
$LinkMethode = "HTTP";
}
elsif ($Link=~s/mailto://) # Methode mailto? (wenn ja mailto: weg)
{
$LinkMethode = "MAILTO";
}
elsif ($Link=~s/ftp://) # Methode ftp? (wenn ja ftp: weg)
{
$LinkMethode = "FTP";
}
elsif ($Link=~s/news://) # Methode news? (wenn ja news: weg)
{
$LinkMethode = "NEWS";
}
elsif ($Link=~s/file://) # Methode news? (wenn ja news: weg)
{
$LinkMethode = "FILE";
}
else # Alles andere auf http. Das wird naemlich
{ # weitergeprueft und man erkennt so einen Fehler
$LinkMethode = "HTTP";
}
###############################################
# absoluten Pfad bauen
if (!($Link=~/^\//)) # Falls relativer Pfad (kein / oder // am Anfang)
{
$Link = "$Pfad$Link"; # Pfad vorne anhaengen
}
if ($Link=~s/^\/\/(.*?)//) # Falls mit Domaine ( // am Anfang)
{
$DomainNeu = $1; # Domaine sichern
}
else
{
$DomainNeu = $DomainPort; # sonst Vaterdomain
}
unless ($Links{"$DomainNeu$LinkNeu"}) # undef falls noch nicht vorhanden
{
# Neuen Link aufnehmen
$Links{"$DomainNeu$Link"}=join(";",($LinkMethode,
"$DomainPort$Url:Z$Zeile","",$LinkTyp));
}
}
} # Naechste Marke bearbeiten
return %Links ;
}
######################################################################
#
# Unterprogramm HoleKopf
#
######################################################################
sub HoleKopf
{
# Uebernahme der Parameter
local($Url,$DomainPort) = @_ ;
# Definition von lokalen Variablen
local(%Links);
#####################################################################
# Port fuer die Kommunikation abspalten, falls angegeben. Wenn nicht,
# mit 80 vorbesetzen.
if ( $DomainPort=~/:/)
{
$Stelle = rindex($DomainPort,":");
$HttpPort = substr($DomainPort,$Stelle+1);
$Domain = substr($DomainPort,0,$Stelle);
}
else
{
$HttpPort = 80;
}
###########################
# Parameter fuer den Socket
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';
# Name des Rechners, von dem aus geprueft wird ermitteln
$hostname = `hostname`;
# Servername fuer die Anbindung aufbereiten
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$HttpPort) = getservbyname($HttpPort,'tcp')
unless $HttpPort =~ /^\d+$/;
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
# Gegenadresse auf gewuenschte Domaine setzen
($name, $aliases, $type, $len, $thataddr) = gethostbyname($Domain);
$that = pack($sockaddr, $AF_INET, $HttpPort, $thataddr);
# Create a handle to the socket
if (!socket(HTTP_Anschluss, $AF_INET, $SOCK_STREAM, $proto))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=600;
return %Links ;
}
# Assign the socket an address
if (!bind(HTTP_Anschluss, $this))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=601;
return %Links ;
}
# Connect to the server
if (!connect(HTTP_Anschluss,$that))
{
#Fehlermeldung in Rueckgabe schreiben und Unterprogramm beenden
$Links{"FEHLER"}=602;
return %Links ;
}
# Eliminate buffering
select(HTTP_Anschluss); # Anschluss HTTP_Anschluss anwaehlen
$| = 1; # Anschluss auf NICHT PUFFERN stellen
select(STDOUT); # Anschluss STDOUT anwaehlen
$| = 1; # Anschluss auf NICHT PUFFERN stellen
# Den Server um den Kopf der Seite $Url bitten
print HTTP_Anschluss "HEAD $Url HTTP/1.0\n\n";
###############################################################
# Nur erste Headerzeile vom Server uebernehmen
<HTTP_Anschluss>=~/HTTP\/1\.0 (\d\d\d)/;
#######################################################
# Auf Fehlermeldungen des Servers ueberpruefen
if ($1 >= 400)
{
$Links{"FEHLER"}=$1;
return %Links ;
}
}
######################################################################
#
# Unterprogramm VerschickeBeiFehler
#
######################################################################
sub VerschickeBeiFehler
{
# Uebernahme der Parameter
local($IniDatei,%Links) = @_ ;
# Definition von lokalen Variablen
#local($NachrichtText,$InNachrichtText,$INI);
$/ = "\n"; # zeilenweise einlesen
$* = 0; # ungleich 0 => Patternsuche ueber mehrere Zeilen
if(!open(INIDATEI,$IniDatei))
{
die "\nKonnte Initialisierungsdatei $IniDatei nicht oeffnen!\n";
}
while(<INIDATEI>) # Durchsuche ini.Datei
{
$INI=$_;
if ($InNachrichtText eq "Ja")
{
if ($INI=~s/>>;//) # Falls Endezeichen zu Text in der Zeile enthalten,
{ # loesche dieses und ...
$NachrichtText = join("\n",$NachrichtText,$INI);
$InNachrichtText = "Nein";
next;
}
else
{
$NachrichtText = join("\n",$NachrichtText,$INI);
next;
}
}
if ($INI=~/^((\s*#)|(\s+))/) # Falls Kommentar- oder Leerzeile:
{
next; # ueberspringen
}
elsif ($INI=~/\[NACHRICHT_AN\]=/) # Adresse von BOSS speichern
{
/=(.*?);/;
$NachrichtAn = "$1";
next;
}
elsif ($INI=~/^\[NACHRICHT\]=DEBUG;/) # Soll in eine Datei abgelegt werden?
{
$MailOpenBoss = '>LinkTest.NACHRICHT'; # In diese Datei legen
next;
}
elsif ($INI=~/^\[NACHRICHT\]=SENDE/) # Soll gesendet werden?
{
$MailFlag = "SENDE";
$MailOpenBoss = "|mail $NachrichtAn";
next;
}
elsif ($INI=~/\[NACHRICHT_TEXT\]=<<(.*)/) # Hole 1. Zeile des Mailtextes
{
$NachrichtText = $1;
$InNachrichtText = "Ja";
next;
}
}
close(INIDATEI);
###################################################################
# Mail an wegschicken
if (!open(MAIL_BOSS,$MailOpenBoss))
{
print "Konnte Filehandle nicht oeffnen";
}
print MAIL_BOSS "Folgender Text wurde bei einem Fehler verschickt:\n----\n";
print MAIL_BOSS "$NachrichtText\n----\n";
print MAIL_BOSS "Auflistung der Fehler:\n======================\n";
@Nachricht = split("{}",$NachrichtText);
$AnzahlFehler = 0; # Fehleranzahl mitzaehlen
while(($Link,$Beschreibung)= each(%Links)) # Laufe durch den Array
{
($LinkMethode,$Vaeter,$Betreuer,$LinkTyp) = split(/;/,$Beschreibung);
if ($Betreuer=~/^\D\D\D/ || !($Betreuer))
{
next;
}
$AnzahlFehler++;
print MAIL_BOSS "\nUrl : $LinkMethode://$Link\n";
print MAIL_BOSS "Vater : ",join("\n\t\t",split(/\|/,$Vaeter)),"\n";
print MAIL_BOSS "Fehler : $Betreuer\n";
print MAIL_BOSS "Betreuer : \n";
@Vaeter=split(/\|/,$Vaeter); # Array Vaeter mit den Vaetern fuellen
foreach $Vater (@Vaeter)
{
$Zeile = substr($Vater,rindex($Vater,":Z")+2);
$Vater = substr($Vater,0,rindex($Vater,":Z"));
$VaterBeschreibung=$Links{$Vater};
($VaterLinkMethode,$Vaeter,$VaterBetreuer,$LinkTyp)=
split(/;/,$VaterBeschreibung);
if ($VaterBetreuer)
{
print MAIL_BOSS "$VaterBetreuer\n";
if ($MailFlag)
{
$MailOpenBetreuer = "|mail $VaterBetreuer";
}
else
{
$MailOpenBetreuer = '>LinkTest.NACHRICHT.BETREUER';
}
open(MAIL_BETREUER,$MailOpenBetreuer);
foreach $Text (@Nachricht)
{
if ($Text eq 'Link')
{
print MAIL_BETREUER $Link;
}
elsif ($Text eq 'Seite')
{
print MAIL_BETREUER $Vater;
}
elsif ($Text eq 'Zeile')
{
print MAIL_BETREUER $Zeile;
}
elsif ($Text eq 'Datum')
{
print MAIL_BETREUER `date`;
}
elsif ($Text eq 'Fehlercode')
{
print MAIL_BETREUER $Betreuer;
}
elsif ($Text eq 'FehlerLang')
{
$FehlerLang = &FehlerBearbeiten($Betreuer);
print MAIL_BETREUER $FehlerLang;
}
else
{
print MAIL_BETREUER $Text;
}
}
close(MAIL_BETREUER);
}
}
}
print MAIL_BOSS "\n=========\nInsgesamt traten $AnzahlFehler Fehler auf\n";
close(MAIL_BOSS);
}