Dieses Script ist eine Neuimplementierung von smbstatus2html.cgi von Rene van Bevern.

!/usr/bin/perl

use warnings; use strict;

use CGI::Carp qw(fatalsToBrowser); use Net::LDAP;

========================== Konfigurationsbereich ========================

my %config = (

hier wird angegeben, ob fuer Lehrer das Login angezeigt werden soll oder
statt dessen ein Ersatzstring (siehe bei UNVISIBLESTRING). Dabei bedeutet
no: ausblenden, yes: anzeigen des Lehrerlogins

TEACHER => 'yes',

geben Sie hier an, fuer welche Accounts, gegebenenfalls zusaetzlich bzw. auch
alternativ zu 'lehrer', das Login nicht angezeigt werden soll.
Format: UNVISIBLE => [ 'ffeuerstein', 'hkirmse' ];

UNVISIBLE => [ ],

hier wird angegeben, was in das Feld der Tabelle eingetragen wird, wenn das
Login nicht angezeigt werden soll, z.B. fuer den Admin. Es sollte kein leerer
String eingetragen werden, weil manche Browser dann die Tabellen nicht
vollstaendig zeichnen. Dieser String kommt nur im Feld Account zur Wirkung.

UNVISIBLESTRING => 'xxxxx',

hier wird angegeben, ob nur die Rechner angezeigt werden, die gerade genutzt
werden (also die unbenutzten PCs ausgeblendet werden sollen). Dabei bedeutet
no: ausblenden, yes: anzeigen der unbenutzten Rechner

ALL_PC => 'yes',

hier wird angegeben, was in das Feld der Tabelle eingetragen wird, wenn der
Rechner nicht besetzt ist. Dieser Parameter hat keine Wirkung, wenn bei
ALL_PC => 'no'; eingetragen wird. Es sollte kein leerer String eingetragen
werden, weil manche Browser dann die Tabellen nicht vollstaendig zeichnen.
Dieser String kommt im Feld IP-Adresse und im Feld Account zur Wirkung.

ALTERNATE_STRING => ' ',

An Schulen wo der Mailserver zur Weitergabe von Informationen genutzt wird,
kann die Anzeige des Logins als Maillink erfolgen. Dabei bedeutet
no: kein Maillink, yes: mit Maillink

MAIL_URL => 'yes',

hier wird angegeben, ob nach Mehrfachanmeldungen gesucht werden soll.
dabei bedeutet no: nicht suchen, yes: nach Mehrfachanmeldungen suchen

MULTIPLE_LOGIN => 'yes',

hier wird angegeben, mit welcher Hintergrundfarbe die Zelle fuer Arbeitsplatz
bei Mehrfachanmeldungen im Netz erscheinen soll.

IM_NETZ => '#F9DED9',

hier wird angegeben, mit welcher Hintergrundfarbe die Zelle fuer Arbeitsplatz
bei Mehrfachanmeldungen im Raum erscheinen soll. Falls Mehrfachanmeldungen im
Netz und im Raum vorliegen, kommt die Mehrfachanmeldung im Raum zur Wirkung.

IM_ROOM => '#EEA395', );

hier können sie das Format fuer das Datum und die Uhrzeit angeben. Die
Platzhalter %%tag%%, %%monat%%, %%jahr%%, %%stunde%%, %%minute%%, %%sekunden%%
werden durch aktuellen Werte ersetzt, wobei alle Werte der Zeit zweistellig sind
durch das vorgegebene Format entsteht z.B. "1.1.2008 13:41:05"

my $format = '%%tag%%.%%monat%%.%%jahr%% %%stunde%%:%%minute%%:%%sekunden%%';

========================== Fehlermeldungen in der Tabelle ===============

my $fehler1 = "Es liegen überhaupt keine Anmeldungen am Fileserver vor"; my $fehler2 = "Es liegen in diesem Raum keine Anmeldungen am Fileserver vor";

========================== HTML-Bereich =================================

Die generierte HTML-Seite wird zusammengesetzt aus dem Kopf, der (eigentlichen)
Tabelle und dem Fuss. Hier wird die Variable $head als HERE-Dokument bereitgestellt.
Ab der 2. Zeile, die mit: "<!doctype html ..." beginnt, ist alles reines HTML.
Sie können damit ohne Perlkenntnisse das Aussehen der Seite beeinflussen.
Beachten Sie, dass %%aufrufer%%, "%%rechner%%", "%%raum%% und %%datum%% durch
das Script durch die aktuellen Werte ersetzt werden

my $head =<<'KOPF'; <!doctype html public "-//W3C//DTD HTML 4.0 //EN"> <html> <head> <title>Anmeldekontrolle</title> <meta name="author" content="Hans-Dietrich Kirmse, Rene van Bevern"> <style type="text/css"> </style> </head> <body background="/online/whttxtr2.jpg" text="#000000" bgcolor="#FFFFFF" link="#0000FF" alink="#0000C0" vlink="#FF0000">

%%aufrufer%% am PC "%%rechner%%" im Raum "%%raum%%"

%%datum%%

Folgende Benutzer dieses Raumes sind angemeldet:

KOPF

die Variable $foot sollte normalerweise nicht geändert werden, da nur Copyrightvermerk.
Falls dieser an irgendeiner anderen Stelle erscheint, ist dagegen natürlich nichts einzuwenden.

my $foot =<<'FUSS';

Arbeitsplatz	IP-Adresse	Account

</body> </html> FUSS

wenn keine Anmeldungen am Fileserver vorliegen, dann wird folgende Tabelle
zurueckgegeben, der Platzhalter %%fehler%% wird dann ersetzt

my $error =<<'FEHLER';

%%fehler%% FEHLER

========================== weitere globalen Variablen ===================

my $ldap_base; # wird z.B. zu 'dc=erg,c=de' my $ip; # IP des Lehrer-PCs my $teacher; # Login des aufrufenden Lehrers my @teacher; # die Logins der Lehrer my $room; # der Raum my %pcs; # die PCs in diesem Raum my @output; # die Ausgabe von smbstatus my @daten; # Daten von smbstatus my %net_connection; # Anmeldungen pro User im Netz my %room_connection; # Anmeldungen pro User im Raum my $date; # Datum und Zeit des Aufrufs my $table; # die Tabelle der HTML-Seite my $ref; # temporaere Variable

========================== Hauptprogramm ================================

wir holen uns das Login des Lehrers, von dem das Script aufgerufen wurde

$teacher = $ENV{REMOTE_USER}; defined($teacher) or die "es liegt keine Anmeldung am Apache vor, $!\n";

wir holen uns die IP des Rechners, von dem das Script aufgerufen wurde

$ip = $ENV{REMOTE_ADDR}; defined($ip) or die "ein unerwarteter Fehler ist aufgetreten, $!\n";

wir holen uns die Lehrer und den Raum und die Rechner fuer diesen Raum

($ref, $room, %pcs) = &get_teachers_and_pcs($ip); # vom LDAP @teacher = @{$ref};

wir rufen 'smbstatus' auf

@output = `smbstatus`; chomp(@output);

jetzt erzeugen wir die Daten zur Bearbeitung von den aktuell angemeldeten PCs.
uns interessieren von @output nur Zeilen, wo am Ende eine Klammer mit der IP ist
Die Daten haben folgende Struktur: $daten[x] = \($ip, $login, $gruppe, $rechner);

@daten = &get_data(@output);

falls ueberhaupt keine Anmeldungen am Fileserver vorliegen, brechen wir hier ab

if (scalar @daten == 0) { $error =~ s/%%fehler%%/$fehler1/; $table = $error; goto AUSGABE; }

wir ermitteln die Anmeldungen pro User im Netz

if ($config{MULTIPLE_LOGIN} eq 'yes') { %net_connection = &get_anz_pro_user(@daten); }

wir reduzieren jetzt (anhand der IP) die Daten auf die Anmeldungen im Raum

@daten = &filtern_nach_raum(\@daten, \%pcs);

falls keine Anmeldungen am Fileserver in diesem Raum vorliegen, brechen wir ab

if (scalar @daten == 0) { $error =~ s/%%fehler%%/$fehler2/; $table = $error; goto AUSGABE; }

wir ermitteln die Anmeldungen pro User im Raum

if ($config{MULTIPLE_LOGIN} eq 'yes') { %room_connection = &get_anz_pro_user(@daten); }

wenn die nichtbenutzten PCs dieses Raumes mit aufgelistet werden sollen,
dann werden für diese PCs "Pseudo-Datensaetze" bereitgestellt

if ($config{ALL_PC} eq 'yes') { @daten = &gen_data_for_all_pcs(\%config, \%pcs, @daten); }

wir sortieren die Datensätze nach den Rechnernamen

@daten = sort { vergleich_rechner($a,$b) } @daten;

falls die Lehrer nicht angezeigt werden sollen
werden jetzt die Logins durch einen Ersatzstring ersetzt

@daten = &substitute_teacherlogins(\%config, \@teacher, @daten);

wir bauen jetzt die eigentliche Tabelle zusammen
es wird hier nur das HTML herumgestrickt (incl. Mehrfachanmeldung, Maillink)

$table = &get_table( \@daten, \%config, \%net_connection, \%room_connection ); AUSGABE:

wir holen uns Datum und Uhrzeit (wird im Kopf der HTML-Seite angezeigt)

$date = &datum($format);

wir bearbeiten den Kopf

$head =~ s/%%aufrufer%%/$teacher/; $head =~ s/%%datum%%/$date/; $head =~ s/%%rechner%%/$pcs{$ip}/; $head =~ s/%%raum%%/$room/;

wir schicken die Seite zum Apache

print "Content-type: text/html\n\n"; print $head; print $table; print $foot;

========================== Funktionen ===================================

--------------------------------------------------------------------
Funktion: Hilfsfunktion zur Ermittlung der Suchbasis
Aufruf: $ldap_base = &_get_ldapbase;
Input: --
Output: Die Suchbasis des LDAP z.B. 'dc=erg,c=de'
Update: 13.08.2007
--------------------------------------------------------------------

sub _get_ldapbase { my $ldap_base = ; # wir durchsuchen die ldap.conf mit einer Regex open DATEI, '<', '/etc/ldap.conf' or die "konnte ldap.conf nicht oeffnen, $!\n"; while (my $zeile = <DATEI>) { if ($zeile =~ m/^\s*base\s+(\w.*\w)\s*$/) { $ldap_base = $1; last; } } close DATEI; return $ldap_base; }

--------------------------------------------------------------------
Funktion: es werden aus dem LDAP zu einer IP der Raum und die Rechner,
Aufruf: (\@teachers,$raum,\%pc) = &get_teachers_and_pcs($ip);
Input: $ip = die IP-Adresse des Lehrerrechners
Output: \@logins = Referenz auf Liste der Lehrerlogins
$raum = Name des Raumes (Rechnergruppierung)
\%pcs = alle Rechner des Raumes (IP => Name)
Update: 16.12.2007
--------------------------------------------------------------------

sub get_teachers_and_pcs { my $ip = shift; my ($ldap_base, $ldap, $mesg, $entry, $dn, $pc, $suchbasis, %rechner, $tmp, $raum, @teacher); # wir verbinden uns mit den LDAP $ldap = Net::LDAP->new('127.0.0.1',version => 3) or die "$@"; $ldap->bind or die "konnte mich nicht mit dem Server verbinden"; # wir holen uns die Suchbasis $ldap_base = &_get_ldapbase; # wir holen uns die Lehrer $mesg = $ldap->search( base => "ou=LEHRER,o=SCHULE,$ldap_base", filter => "gidNumber=101", attrs => [ 'uid' ], scope => "sub"); mesg->code and die $mesg->error; # wir stecken die Daten aus den Entries in einen "normalen" Hash @teacher = (); foreach my $entry ($mesg->entries) { push @teacher, $entry->get_value('uid'); } # wir holen uns den Raum zu der IP ($ip) $mesg = $ldap->search( base => "cn=DHCP Service Config,o=DHCP,$ldap_base", filter => "dhcpStatements=fixed-address $ip", attrs => [ 'dhcpHost' ], scope => "base"); mesg->code and die $mesg->error; # wir holen uns den DN ($entry) = $mesg->entries or die "konnte keinen dhcpHost finden"; $dn = $entry->dn; # wir spalten vom DN den Rechnernamen ab, den Rest nehmen wir gleich als Suchbasis ($pc, $suchbasis) = $dn =~ /^cn=([^,]*),(.*)$/; # wir holen uns die Rechner (sind im DN) und IPs zu diesen Raum $mesg = $ldap->search( base => $suchbasis, filter => "objectClass=dhcpHost", attrs => [ 'dhcpStatements' ]); $mesg->code and die $mesg->error; # wir stecken die Daten aus den Entries in einen "normalen" Hash %rechner = (); foreach my $entry ($mesg->entries) { $dn = $entry->dn; ($pc) = $dn =~ /^cn=([^,]*),/ ; # die Klammer ist der Rechnername $tmp = $entry->get_value('dhcpStatements'); ($ip) = $tmp =~ /fixed-address (.*)$/; $rechner{$ip} = $pc; } # wir holen uns noch den Raum ($raum) = $suchbasis =~ /^cn=([^,]*),/ ; # die Klammer ist der Raum # wir trennen uns vom LDAP $ldap->unbind; return (\@teacher, $raum, %rechner); }

--------------------------------------------------------------------
Funktion: aus der Ausgabe von smbstatus werden die Daten herausgezogen
Aufruf: @daten = &get_data(@output);
Input: @output = die Ausgabe von smbstatus
Output: $daten[x] = \($ip, $login, $gruppe, $rechner);
Update: 13.08.2007
--------------------------------------------------------------------

sub get_data { my @output = @_; my @daten = (); foreach my $zeile (@output) { if ($zeile =~ /^ \d+\s* # die PID (\w+)\s* # der User (login) = $1 (\w+)\s* # die Gruppe = $2 (\w+)\s* # der Rechnername = $3 $(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$ # die IP = $4 $/x) { my @values = ( $4, $1, $2, $3 ); # wird eine anonyme Liste push @daten, \@values; } } return @daten; }

--------------------------------------------------------------------
Funktion: es werden die Anzahl der Anmeldungen pro User ermittelt
Aufruf: %connection = &get_anz_pro_user(@daten);
Input: $daten[x] = \($ip, $login, $gruppe, $rechner);
Output: $connection{$user} = $anzahl;
Update: 16.12.2007
--------------------------------------------------------------------

sub get_anz_pro_user { my @daten = @_; my %ip2user = (); foreach my $datum (@daten) { $ip2user{${$datum}[0]} = ${$datum}[1]; } my (%anzahl_anmeldungen, $user); foreach my $ip (keys %ip2user) { $user = $ip2user{$ip}; if (defined($anzahl_anmeldungen{$user})) { $anzahl_anmeldungen{$user}++; } else { $anzahl_anmeldungen{$user} = 1; } } return %anzahl_anmeldungen; }

--------------------------------------------------------------------
Funktion: es werden nur die Datensaetze aus diesem Raum zurueckgegeben
Aufruf: @daten = &filtern_nach_raum(\@daten, \%pcs);
Input: $daten[x] = \($ip, $login, $gruppe, $rechner);
$pcs{$ip} = $rechnername;
Output: $daten[x] = \($ip, $login, $gruppe, $rechner);
Update: 16.12.2007
--------------------------------------------------------------------

sub filtern_nach_raum { my $lref_daten = shift; my $href_pcs = shift; my @daten = @{$lref_daten}; my %pcs = %{$href_pcs}; my ($ip, @temp); foreach my $nr (@daten) { my @liste = @{$nr}; # wir holen uns die IP $ip = $liste[0]; # nur wenn diese IP zu den Rechnern des Raumes gehoert if (defined($pcs{$ip})) { # dann wollen wir diesen Datensatz push @temp, \@liste; } } return @temp; }

--------------------------------------------------------------------
Funktion: es werden die Logins durch einen Ersatzstring ersetzt
Aufruf: @daten = &substitute_teacherlogins(\%config, \@teacher, @daten);
Input: %config = die Daten der Konfiguration
$daten[x] = \($ip, $login, $gruppe, $rechner);
Output: $daten[x] = \($ip, $login, $gruppe, $rechner);
Update: 16.12.2007
--------------------------------------------------------------------

sub substitute_teacherlogins { my $href_config = shift; my $lref_teacher = shift; my @daten = @_; my %config = %{$href_config}; my @teacher = @{$lref_teacher}; my ($login, $anz, %teacher, @unvisible, %unvisible); # wir bearbeiten zuerst die Lehrerlogins if ($config{TEACHER} eq 'no') { # um die Lehrerlogins schneller zu finden, erstellen wir einen Hash foreach my $element (@teacher) { $teacher{$element} = 1; } } # wir holen uns noch die Logins, die nicht angezeigt werden sollen @unvisible = @{$config{UNVISIBLE}}; # auch daraus erstellen wir einen Hash foreach my $element (@unvisible) { $unvisible{$element} = 1; } foreach my $datum (@daten) { my @tmp = @{$datum}; # holen wir das Login $login = $tmp[1]; # wir ueberpruefen, ob das Login im Hash %teacher ist if (exists($teacher{$login})) { $tmp[1] = $config{UNVISIBLESTRING}; # Login ersetzen $datum = \@tmp; } else { # wir ueberpruefen, ob es im Hash %unvisible ist if (exists($unvisible{$login})) { $tmp[1] = $config{UNVISIBLESTRING}; # Login ersetzen $datum = \@tmp; } } } return @daten; }

--------------------------------------------------------------------
Funktion: fuer unbesetzte PCs werden Dummy-Datensaetze ergaenzt
Aufruf: @daten = &gen_data_for_all_pcs(\%config, @daten);
Input: %config = die Daten der Konfiguration
$daten[x] = \($ip, $login, $gruppe, $rechner);
Output: $daten[x] = \($ip, $login, $gruppe, $rechner);
Update: 16.12.2007
--------------------------------------------------------------------

sub gen_data_for_all_pcs { my $href_conf = shift; my $href_pcs = shift; my @daten = @_; my %conf = %{$href_conf}; my %pcs = %{$href_pcs}; # wir stecken jetzt die Datensaetze in einen Hash, wobei der Key # der Rechnername und der Value der ganze Datensatz ist my %help = (); my @datensatz = (); foreach my $ds (@daten) { @datensatz = @{$ds}; $help{$datensatz[3]} = $ds; } my @neu = (); my $temp; # fuer jeden PC aus diesem Raum (laut LDAP) foreach my $key (keys %pcs) { my @tmp = ($conf{ALTERNATE_STRING}, $conf{ALTERNATE_STRING}, $conf{ALTERNATE_STRING}, ); $temp = $pcs{$key}; # $temp ist der Rechnername # wenn es diesen Rechnername in den Datensaetzen von smbstatus gibt if (exists( $help{$temp} )) { # dann nehmen wir diesen push @neu, $help{$temp}; } else { # sonst pushen wir einen Dummy-Datensatz $tmp[3] = $temp; push @neu, \@tmp; } } return @neu; }

--------------------------------------------------------------------
Funktion: es wird die eigentliche Tabelle zusammengesetzt
Aufruf: $table = &get_table(\@daten,\%config,\%net_connection,\%room_connection);
Input: @daten = die bearbeiteten Daten aus smbstatus
%config = die Konfiguration
%net_connection - die Anzahl der Anmeldungen im Netz
%room_connection - die Anzahl der Anmeldungen im Raum
Output: $tabelle = die Tabelle als ein großer String
Update: 30.12.2007
--------------------------------------------------------------------

sub get_table { my $lref_daten = shift; my $href_config = shift; my $href_net_connection = shift; my $href_room_connection = shift; my @daten = @{$lref_daten}; my %config = %{$href_config}; my %net_connection = %{$href_net_connection}; my %room_connection = %{$href_room_connection}; my $tabelle = ; my (@temp, $login, $farbe); foreach my $datum (@daten) { @temp = @{$datum}; $tabelle .= ''; # Beginn der HTML-Zeile # ---------- die 1. Spalte: "Arbeitsplatz" ------------ $login = $temp[1]; $farbe = ; # wenn Mehrfachanmeldungen angezeigt werden sollen if ($config{MULTIPLE_LOGIN} eq 'yes') { if (exists($net_connection{$login}) and ($net_connection{$login} > 1)) { $farbe = $config{IM_NETZ}; } if (exists($room_connection{$login}) and ($room_connection{$login} > 1)) { $farbe = $config{IM_ROOM}; } } if ( $farbe ne ) { $tabelle .= ''.$temp[3].'';

   }
   else {

$tabelle .= ''.$temp[3].'';

   # -------- die 2. Spalte: "IP-Adresse" ------------

$tabelle .= ''.$temp[0].''; # IP

   # -------- die 3. Spalte: "Account" ---------------

   # wenn der Maillink angezeigt werden soll
   if ( ($config{MAIL_URL} eq 'yes')
         and ($temp[1] ne $config{UNVISIBLESTRING})
         and ($temp[1] ne $config{ALTERNATE_STRING}) ) {

$tabelle .= '<a href="mailto:'.$temp[1].'@arktur">'.$temp[1].'</a>';

   }
   else {

$tabelle .= ''.$temp[1].'';

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

$tabelle .= ''."\n"; # Ende der HTML-Zeile } return $tabelle; }

--------------------------------------------------------------------
Funktion: Vergleichsfunktion fuer's Sortieren der Daten nach Rechnernamen
Aufruf: @daten = sort { vergleich_rechner($a,$b) } @daten;
Input: $a, $b = Datensaetze aus der Liste
Output: -1 | 0 | 1 fuer "kleiner" | "gleich" | "groesser"
Update: 30.12.2007
--------------------------------------------------------------------

sub vergleich_rechner { my $lref_a = shift; my $lref_b = shift; my @datensatz1 = @{$lref_a}; my @datensatz2 = @{$lref_b}; return ($datensatz1[3] cmp $datensatz2[3]); }

--------------------------------------------------------------------
Funktion: Hilfsfunktion zur zweistelligen Darstellung der Zeitdaten
Aufruf: $sek = &zweistellig($sek);
Input: $sek oder $min oder $std
Output: diese Werte, aber zweistellig
Update: 1.01.2008
--------------------------------------------------------------------

sub zweistellig { my $datum = shift; if ($datum < 10) { $datum = '0'.$datum } return $datum; }

--------------------------------------------------------------------
Funktion: liefert formatierten Datumsstring
Aufruf: $date = &datum($format);
Input: String fuer das Ausgabeformat
Output: String mit Datum und Uhrzeit
Update: 1.01.2008
--------------------------------------------------------------------

sub datum { my $format = shift; my @date = localtime(); my $sek = $date[0]; my $min = $date[1]; my $std = $date[2]; my $tag = $date[3]; my $monat = $date[4] + 1; my $jahr = $date[5] + 1900; $sek = &zweistellig($sek); $min = &zweistellig($min); $std = &zweistellig($std); my $rueckgabe = $format; $rueckgabe =~ s/%%tag%%/$tag/; $rueckgabe =~ s/%%monat%%/$monat/; $rueckgabe =~ s/%%jahr%%/$jahr/; $rueckgabe =~ s/%%stunde%%/$std/; $rueckgabe =~ s/%%minute%%/$min/; $rueckgabe =~ s/%%sekunden%%/$sek/; return $rueckgabe; } __END__ </source>

Benutzer:Kirmse/Anmeldekontrolle

Folgende Benutzer dieses Raumes sind angemeldet:

Navigationsmenü

Benutzer:Kirmse/Anmeldekontrolle

Folgende Benutzer dieses Raumes sind angemeldet:

Navigationsmenü

Suche