in reply to What does your old Perl code look like?

Should I really publish my first perpetrations in perl? Ok, since this is long ago and doesn't really matter anyways, here it goes... 1137 lines of naughty code, released on April 15, 1994.

Written for perl 4, patchlevel 36. At our CAD lab in the university, we had to force people to clean up their home directories by themselves. Nine SPARCstation 10, 1 IPX, 2 SPARCstation 2 and a SPARCserver 300 with 16MB of RAM and some disks, doing NFS. All workstations doing NFS, automounting stuff from there to here. Disk storage was expensive, and we didn't have enough. 60-80 students producing huge crap files. We were tired of "Can't login!"-complaints due to "file system full" conditions.

Hence, "hund" (dog).

Run as root, this script sniffed the home dirs of all NIS users (yellow tables) and checked their disk usage. If the home dir was over quota, it installed itself as the only xinit client running in a xterm or cmdtool, so users over quota didn't get their desktop, but this shitty tcsh fake (far from complete or perfect) which it was for non-root, and allowed only commands to reduce disk space. It would persist until the low disk quota watermark (soft limit) was reached. It had escapes, though. My first software with security holes :-)

Believe it or not, this actually *did* run in our network, and it helped a bit. I'm not asking for bug reports or style complaints, thank you. Too much spaghetti, I know. Beat that bloke at 25 years ago, not me.

For publishing, the code was run through perltidy to convert tabs to 4 spaces, and Encode for UTF8, otherwise it is as it had been.
Comments are in german, as is the embedded nroff manual page, sorry about that, i18n wasn't required. My linux nroff -man hund | less -R doesn't grok the diversion and ignore tags (di and ig00) and formats the code as well, but at the end it displays the manual page just fine.

Long time ago, and I was proud of it. Go figure.

#!/usr/local/bin/perl 'di'; ###### +##### 'ig00'; # WARN +ING # # TCSH FAKE and WATCHDOG - HUND - ###### +##### ###################################################################### +##### ################################################################# NO + # ######################################################### RESPONSABIL +ITY # ################################################ IS ASSUMED BY THE AUT +HOR # ######################################### OR THE INSTITUTION HE WORKS +FOR # ################################## FOR ANY DAMAGE OR LOSS CAUSED BY T +HIS # ######################### SOFTWARE. I HAD ENOUGH TROUBLE HACKING THIS, + SO # ################# HELP YOURSELF TESTING AND DEBUGGING. ***** ******, +IGP # ###################################################################### +##### ######## REFER TO HUND(8) FOR FURTHER INFORMATION + # ###################################################################### +##### # Hund - als root: prueft den Plattenplatz und herumfahrende Pr +ozesse # aller Benutzer im lokalen Netz. # - als nicht-root: TCSH -fake zum Aufraeumen. MAIL an root, # wenn was schief läuft. ###################################################################### +##### $mail = "Hallo,\n\nhier Hund, wau.\n"; # Diese Shell erlaubt die Reduzierung des Plattenplatzes und die Beend +i- # gung laufender Prozesse, mehr nicht. # Wo steckt hund? ( $0 =~ m|(.*)/[a-z]+| ) && ( $hunddir = $1 ); # print $hunddir,"\n"; ### TEST ### &read_cfg; $mailto = $CFG{'mailalias'}; # Die Benutzer können ihr Geraffel in das Verzeichnis schmeißen, das # von der Befehlszeile übergeben wird: $GERAFFELDIR = $ARGV[0]; unless ($>) { if ($GERAFFELDIR) { ( -e $GERAFFELDIR ) || die "$GERAFFELDIR: $!\n"; ( -d $GERAFFELDIR ) || die "$GERAFFELDIR: Not a directory\n"; } } # Wann ? Heutiges Datum - auf deutsch $date = ( 0 .. 31 )[ (localtime)[3] ]; $mon = ( Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec ) [ (localtime)[4] ]; $year = ( localtime(time) )[5]; @months = ( Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec + ); @monate = ( Januar, Februar, 'März', April, Mai, Juni, Juli, August, September, Oktober, November, Dezember ); for ( 0 .. 11 ) { $m{ $months[$_] } = $monate[$_]; } $today = "$date. $m{$mon} $year"; # Hund prueft Plattenplatz, Prozesse. unless ($>) { # root uid #if ($> = 521) { # faker uid # Suche auf dem Netz nach laufenden Prozessen # Schreibe diese in $HOME/.ps$USER $mail .= "Hat nicht alles geklappt; es gab ein paar Fehler:\n"; @hosts = ( 'arthimis', 'eos', 'eris', 'diogenes', 'hera', 'hekate', 'kybele', 'meuren', 'nike', 'persephone', 'phidias', 'sokrates', 'styx' ); foreach $host (@hosts) { # print STDERR "$host:\n"; ### TEST ### open( IN, "rsh $host ps -auxc |" ) || ( $warn .= "rsh auf $host ging nicht : $!\n" ); while (<IN>) { next if /^USER/; next if /^root/; next if /^daemon/; next if /^sys/; next if /^bin/; next if /^uucp/; next if /^audit/; next if /^sync/; next if /^sysdiag/; next if /^sundiag/; next if /rpc.frameusersd/; $user = substr( $_, 0, 8 ); $pid = substr( $_, 9, 5 ); $sz = substr( $_, 24, 5 ); $start = substr( $_, 43, 6 ); $command = substr( $_, 56 ); if ( $start !~ /[A-Z]/ ) { $start = $today; } else { $start =~ s/([A-z]+) +(\d+)/$2\. $m{$1}/; } $user =~ s/ //g; $pid =~ s/ //g; $sz =~ s/ //g; #$command =~ s/ //g; $file{$user} .= join( ';', $host, $pid, $sz, $start, $comm +and ); } } foreach $user ( keys(%file) ) { # Files schreiben. unless ( chdir("/home/$user") ) { $warn .= "$user hat kein Home - Verzeichnis.\n"; next; } if ( open( OUT, "> .ps$user" ) ) { print OUT $file{$user}; ( close OUT ) || ( $warn .= "Kann filehandle nicht schliessen: $!\n" ) +; } else { $warn .= "Kann /home/$user/.ps$user nicht schreiben: $!\n" +; next; } unless ( -e "/home/$user/.xinitrc.hund" ) { # Hat schon. unless ( rename( ".xinitrc", ".xinitrc.hund" ) ) { $warn .= "Kann .xinitrc von $user nicht umbenennen: $! +\n" ; # .xinitrc umbe +nennen next; } unless ( open( IN, "<.xinitrc.hund" ) ) { $warn .= "Kann .xinitrc.hund nicht lesen: $!\n" ; # Neue .xinitrc + schreiben next; } unless ( open( OUT, ">.xinitrc" ) ) { $warn .= "Kann .xinitrc nicht schreiben: $!\n"; next; } select(IN); $| = 1; select(STDIN); select(OUT); $| = 1; select(STDOUT); while (<IN>) { $this = $_; unless (/openwin-sys/) { print OUT $this; } unless ($wm) { # if (/\btwm\b/ || /\bolwm\b/ || /\btvtwm\b/ || +/\bolvwm\b/){ if (m|#!/|) { # fake here. Ein paar Einträge, um den IGP - Windowmanager vorzu +schalten. print OUT <<TO_HERE; \$OPENWINHOME/lib/openwin-sys twm -f $CFG{'WMRC'} & cmdtool $0 $GERAFFELDIR & wait TO_HERE $wm++; } } # print OUT $this; } } } if ($warn) { $warn .= "\n\nwau, wau,\n\nhund."; # Alles Liebe, Dein hund +. open( MAIL, "| mail -s 'hund schnüffelt' $mailto" ); # Mail + an root print MAIL $mail, $warn; close MAIL; } exit 0; } # Hund fuer User: TCSH - Emulation. # wer überhaupt? $user = $ENV{'USER'}; $User = ( getpwnam($user) )[6]; # Mail an root. chop( $ENV{'HOSTNAME'} = `hostname` ); # für den Prompt. $mail .= "$User ($user) hat sich am $today auf $ENV{'HOSTNAME'} eingel +oggt.\n"; # Gibts GERAFFELDIR? if ($GERAFFELDIR) { unless ( -e $GERAFFELDIR && -d $GERAFFELDIR ) { $warn = "$GERAFFELDIR: ungültiges Verzeichnis.\n\nwau,wau,\n\nhund.\ +n~."; open( MAIL, "| mail -s 'hund bellt: $GERAFFELDIR' $mailto" ) ; # Mail an root print MAIL $mail, $warn; close MAIL; undef $GERAFFELDIR; } else { if ( !-e "$GERAFFELDIR/$user" ) { system "mkdir $GERAFFELDIR/$user"; } } } # Diese Signale werden abgefangen: # INT QUIT TERM LOST TSTP HUP #$SIG{'INT'} = 'nope'; #$SIG{'TSTP'} = 'nope'; $SIG{'HUP'} = 'hup'; $SIG{'INT'} = 'int'; $SIG{'QUIT'} = 'quit'; $SIG{'ILL'} = 'ill'; $SIG{'TRAP'} = 'trap'; $SIG{'IOT'} = 'iot'; $SIG{'EMT'} = 'emt'; $SIG{'FPE'} = 'fpe'; $SIG{'KILL'} = 'kill'; $SIG{'BUS'} = 'bus'; $SIG{'SEGV'} = 'segv'; $SIG{'SYS'} = 'sys'; $SIG{'PIPE'} = 'pipe'; $SIG{'ALRM'} = 'alrm'; $SIG{'TERM'} = 'term'; $SIG{'URG'} = 'urg'; $SIG{'STOP'} = 'stop'; $SIG{'TSTP'} = 'tstp'; $SIG{'CONT'} = 'cont'; # $SIG{'CHLD'} = 'chld'; $SIG{'TTIN'} = 'ttin'; $SIG{'TTOU'} = 'ttou'; $SIG{'IO'} = 'io'; $SIG{'XCPU'} = 'xcpu'; $SIG{'XFSZ'} = 'xfsz'; $SIG{'VTALRM'} = 'vtalrm'; $SIG{'PROF'} = 'prof'; # $SIG{'WINCH'} = 'winch'; $SIG{'LOST'} = 'lost'; $SIG{'USR1'} = 'usr1'; $SIG{'USR2'} = 'usr2'; chdir; # nach Hause. $CD++; # Inhalt des Verzeichnisses in Hash-Tabelle. (-> sub prompt) chop( $ENV{'PWD'} = `pwd` ); # zur Sicherheit. $ENV{'SHELL'} = $0; # diese Shell. @TTY = split( /\//, `tty` ); # Terminal ermitteln. chop( $ENV{'TTY'} = pop(@TTY) ); undef @TTY; # Terminal auf Einzelzeichen-Modus open( SAVEOUT, ">&STDOUT" ); open( TTYIN, "</dev/$ENV{TTY}" ) || die "Can't read /dev/$ENV{TTY}: +$!\n"; open( TTYOUT, ">/dev/$ENV{TTY}" ) || die "Can't write /dev/$ENV{TTY}: + $!\n"; select(TTYOUT); $| = 1; select(STDOUT); select(TTYIN); $| = 1; select(STDIN); $BSD = -f '/vmunix'; $pscmd = $BSD ? "ps -uxc" : "ps -ef"; # Auch für andere Systeme. if ($BSD) { system "stty cbreak < /dev/$ENV{TTY} > /dev/$ENV{TTY} 2>&1"; } else { # weil das IGP PC's will... system "stty", 'cbreak'; system "stty", 'eol', '^A'; } # Informationen über Plattenplatz / Prozesse $dufile = "/home/$user/.du$user"; $psfile = "/home/$user/.ps$user"; # - Plattenplatz if ( -e $dufile ) { open( IN, ".du$user" ); while (<IN>) { if (/^Limit\s+:\s+(\d+) kB/) { $limit = $1; } if (/^Plattenplatz: (\d+) kB/) { $ize = $1; } } $beginsize = $ize if $ize; $o = $ize - $limit; } else { $dufile = ''; # $beginsize = &size; # Auskommentiert, braucht zu lange. } # - Prozesse. if ( -e $psfile ) { open( IN, ".ps$user" ); while (<IN>) { $procnt++; ( $host, $rest ) = split( ';', $_, 2 ); $proc{$host} .= $_; } } else { $psfile = ''; } # Ursprüngliche Einstellungen herstellen. system 'mv -f .xinitrc.hund .xinitrc' if -e "$ENV{'HOME'}/.xinitrc.hun +d"; @hostcnt = ( keys(%proc) ); $hostcnt = @hostcnt; undef @hostcnt; # Nur diese Befehle werden unterstützt: # Befehle, die keine S +onderbehandlung bedürfen, # Alias Befehl # werden direkt /bin/s +h übergeben (bzw /usr/local/bin/tcsh ?). # Sonderbehandlung im Block sub syntax { }. %CMD = ( 'cd', 'cd', 'compress', 'compress', 'cp', 'cp -i', # Sonderbehandlung 'du', 'du -s', 'exit', 'exit', # Sonderbehandlung 'fdformat', 'fdformat -fd', 'find', 'find', # Sonderbehandlung: kein -exec. 'ls', 'ls -F', 'ln', 'ln', 'll', 'ls -Flg', 'm', 'less', 'man', 'man', # Sonderbehandlung 'mkdir', 'mkdir', 'mount.pcfs', 'mount.pcfs', 'mv', 'mv -i', 'prozesse', 'prozesse', 'ps', $pscmd, 'rm', 'rm', 'rmdir', 'rmdir', 'tar', 'tar', # Sonderbehandlung: freien Plattenplatz checken. 'umount.pcfs', 'umount.pcfs', '..', 'cd', # Lokale tcsh Einstellung. ',', ',', # Lokale tcsh Einstellung. '?', '?' # Hilfstext ); $CMD{'stapel'} = 'stapel' if $GERAFFELDIR; # Wenn Verzeichnis definiert, dann gibts den Bef +ehl. unless ( $CFG{'message_header'} ) { print TTYOUT <<EOA ; Ihr Account ist unordentlich! Das darf nicht sein. EOA } else { print TTYOUT $CFG{'message_header'}; } if ( $o > 0 ) { unless ( $CFG{'message_du'} ) { print TTYOUT <<EOB; Sie verbrauchen zuviel Speicherplatz auf Ihrer Festplatte. Benutzter Plattenplatz: $ize kBytes Limit: $limit kBytes --------------------------------------- Überschreitung um $o kBytes Löschen Sie alte oder nicht benötigte Dateien, ziehen Sie diese auf Di +skette. EOB } else { $CFG{'message_du'} =~ s/\$ize/$ize/g; $CFG{'message_du'} =~ s/\$limit/$limit/g; $CFG{'message_du'} =~ s/\$o/$o/g; print TTYOUT "$CFG{'message_du'}"; } } if ($procnt) { unless ( $CFG{'message_ps'} ) { ($procnt) && print TTYOUT <<EOC; Es gibt $procnt nicht abgeschlossene Prozesse auf $hostcnt Rechnern im + Netz, die Ihnen gehören. EOC } else { $CFG{'message_ps'} =~ s/\$procnt/$procnt/g; $CFG{'message_ps'} =~ s/\$hostcnt/$hostcnt/g; print TTYOUT $CFG{'message_ps'}; } } $HELP = <<EOE; Es stehen Ihnen folgende Befehle zur Verfügung: cd - wechselt ins angegebene Verzeichnis cp - kopiert Dateien compress - komprimiert Dateien mv - verschiebt Dateien / benennt Dateien um ls - gibt den Inhalt des aktuellen Verzeichnisses aus ll - wie ls, aber mit Information über Dateityp, Eigner, Gruppenzugehörigkeit, Größe und Datum ln - legt einen Verweis an du - gibt die Größe des aktuellen Verzeichnisses aus rm - löscht Dateien mkdir - legt ein Verzeichnis an rmdir - löscht leere Verzeichnisse man <befehl> - ruft die Handbuchseite für den Befehl <befehl> auf. fdformat - formatiert eine Diskette für MS-DOS mount.pcfs - hängt eine Diskette ins Dateiensystem ein umount.pcfs - hängt die Diskette wieder aus und gibt sie frei prozesse - alte Prozesse beenden ? - gibt diese Liste aus exit - beendet das Programm <Control> L - putzt das Terminal EOE # help <befehl> - erzählt mehr über den Befeh +l <befehl> # später! if ($GERAFFELDIR) { $HELP .= <<EOF; stapel - lagert Dateien ins temporäre Verzeichnis $GERAFFELD +IR aus. Die Dateien in diesem Verzeichnis werden nach 1 Woc +he gelöscht - Zeit genug, um sie auf Diskette zu ziehe +n. EOF } print TTYOUT $HELP, "\n"; unless ( $CFG{'message_tail'} ) { print TTYOUT <<EOD; Räumen sie bitte ihren Account auf. Nach Beendigung dieses Programms werden Sie sich in ihrer gewohnten Um +gebung wiederfinden. EOD } else { print TTYOUT $CFG{'message_tail'}; } &prompt; ###################################################################### +##################################################################### +################## # now read in single chars ######################################### M +AIN LOOP ############################################################ +################## for ( ; ; ) { read( TTYIN, $this, 1 ); if ( $this eq '^L' ) { print TTYOUT $this; &prompt; print TTYOUT $that; next; } # <Control> L if ( $this eq ' || $this eq "\010" || $this eq "\177" ) { # <Backspace> <Del> <Control> H if ($that) { print TTYOUT "\010 \010"; $that = substr( $that, 0, ( length($that) - 1 ) ); } } else { if ( $this eq "\t" ) { # <Tab> &expand; # variable expansion. } elsif ( $this eq "\n" ) { # <Return> print TTYOUT "\n"; unless ($that) { &prompt; next; } $_ = $that; $that = ''; # s/\010//g; close(STDOUT); open( STDOUT, ">&SAVEOUT" ); select(STDOUT); $| = 1; $_ = &syntax ; # Hier wird geprüft, ob der Befehl gültig ist (-> sub + syntax) # print STDOUT $_,"\n"; eval $_; select(TTYOUT); $| = 1; select(STDOUT); # if ($this &prompt; } else { # Alle sonstigen Zeichen print TTYOUT $this; $that .= $this; } } } ###################################################################### +##################################################################### +################## ###################################################################### +##################################################################### +################## # subroutines sub read_cfg { # default values %CFG = ( 'WM', 'twm', 'WMRC', 'hund.wmrc', 'mailalias', 'root', # '' , '', ); open( IN, "<$hunddir/hund.cfg" ) || ( $mail .= "Kann hund.cfg nicht finden\n" ); if ( open( IN, "<$hunddir/hund.cfg" ) ) { while (<IN>) { # read next if /^#/; # variables if (/^(\w+)[ \t]+([a-z\/\.]+)/) { #simple variable if ( $CFG{$1} ) { $CFG{$1} = $2; } } elsif (/\}/) { undef $block; } if ($block) { $CFG{$this} .= $_; } if (/^(\w+)[ \t]+\{/) { # block $block++; $this = $1; } } } } sub prompt { if ($CD) { chop( $cwd = `pwd` ); opendir( DIR, '.' ); @files = grep( !/^\.\.?$/, readdir(DIR) ); # . und .. vermeiden durc +h grep( ). } $cwd =~ s/${ENV{'PWD'}}/${ENV{'HOME'}}/; undef $CD; print TTYOUT "$ENV{'HOSTNAME'} [$user] $cwd >"; } sub syntax { # verboten: if (/\;/) { print TTYOUT "Sorry, nur ein Befehl pro Zeile.\n"; $_ += ''; } if (/\|/) { # Pipe. Mal sehen, wohin gepfiffen wird. @items = split( '|', $_ ); foreach $item (@items) { ( $icmd, $itail ) = split( ' +', $item, 2 ); unless ( $CMD{$icmd} ) { # Hund stellt sich dumm. print TTYOUT "Hund (stellt sich dumm, pfeift): Tülülü, lülü, lülü ...\n"; $_ = ''; last; } } } local ( $cmd, $tail ) = split( ' +', $_, 2 ); $tail =~ s#~/#/home/$user/#g; $tail =~ s#~ *$#/home/$user/#; # Test: # print TTYOUT "$tail\n"; # read(TTYIN,$ans,1); # $_ = '' unless $ans eq 'w'; if ( $CMD{$cmd} ) { # Sonderbehandlung für cd, man, cp, exit, find, ".." if ( $cmd eq 'cd' ) { $CD++; #if ($tail =~ m|^/| && !($tail =~ m|^/pcfs| || $tail =~ m|^/home/$user +| || (! $GERAFFELDIR || $tail =~ m|^$GERAFFELDIR/$user|))){ # print TTYOUT "Sie haben Hausarrest.\n"; # Blödsinn # # $tail = $cwd; $CD--; #} elsif ($tail =~ m#^\.\.#) { # if ($cwd eq "/home/$user") { # print TTYOUT "Sie haben Hausarrest!\n"; # $CD--; # $tail = '.'; # } #} $merkdas = $tail; $merkdas =~ s/\\ / /g; if ( !-d $merkdas ) { $_ = "print '$merkdas: Not a directory.\n'"; } else { $_ = "chdir('$merkdas')"; } } elsif ( $cmd eq '..' ) { $CD++; if ( $cwd eq "/home/$user" ) { print TTYOUT "Sie haben Hausarrest.\n"; $CD--; } else { $dot = $cwd; $_ = "chdir('..')"; } } elsif ( $cmd eq ',' ) { $_ = ($dot) ? "chdir('$dot')" : "print 'dot: Undefined variab +le.\n'"; $CD++ if $dot; } elsif ( $cmd eq 'man' ) { $_ = "system '$_ | less'"; } elsif ( $cmd eq 'cp' ) { @tail = split( ' +', $tail ); $lasttail = pop(@tail); if ( $lasttail !~ "/pcfs" ) { $_ = "print 'cp: No space left on device.\n'"; } else { $_ = "system '$_'"; } } elsif ( $cmd eq 'mv' ) { # Man muss tatsächlich fast alles selber machen! $_ = "system 'mv -i $tail'"; } elsif ( $cmd eq 'stapel' ) { $_ = "system 'mv -i $tail $GERAFFELDIR/$user/'"; } elsif ( $cmd eq 'find' ) { if ( $tail =~ '-exec' ) { $_ = "print TTYOUT 'Das dürfen Sie aber nicht! Ich pet +ze!.\n'"; } elsif ( $tail =~ 'cmdtool' ) { $_ = "print TTYOUT 'Sapperlot! Sie Schlawiner!\n'"; } else { $_ = "system '$_'"; } } elsif ( $cmd eq 'exit' ) { print TTYOUT "\nMoment ...\n"; $EXIT++; if ($limit) { ($ize) = &size; $o = $ize - $limit; $EXIT++; undef $WARN; if ( $o < 0 ) { $o = $o * (-1); print TTYOUT "Sie haben $o kB freien Plattenplatz. +\n"; system "rm -f $dufile"; } else { print TTYOUT "Sie sind noch mit $o kBytes über dem Limit.\nRäumen Sie noch ein bißc +hen.\n"; $EXIT = 0; $WARN++; } } if ($procnt) { print TTYOUT "Sie haben $procnt hängende Prozesse.\n" if $procnt > 1; print TTYOUT "Sie haben noch einen hängenden Prozess.\ +n" if $procnt == 1; $EXIT = 0; $WARN++; } if ($WARN) { print TTYOUT "\nWollen Sie das Programm trotzdem beenden?\nexit? +(y|n) >"; read( TTYIN, $ans, 1 ); if ( $ans =~ /^y/i ) { $EXIT++; $ans = 'yes'; } else { $ans = 'no'; } print TTYOUT "$ans\n"; } if ($EXIT) { open( IN, "ps -uxc |" ); while (<IN>) { if (/\w+ +(\d+).* twm/) { $killpid = $1; } } if ($killpid) { kill 'HUP', $killpid; } &term; } $_ = ''; } elsif ( $cmd eq 'prozesse' ) { &zap; $_ = ''; } elsif ( $cmd eq '?' ) { system "clear"; print TTYOUT $HELP, "\n"; $_ = ''; } else { s/$cmd/$CMD{$cmd}/; $_ = "system '$_'"; } ###################################################################### +########### # } elsif ($cmd eq 'q'){ + # # $_ = 'exit'; # Debugging - + # # } elsif ($cmd =~ /^\\/){ # Zeilen + # # s/\\//; + # ###################################################################### +########### } else { $_ = "print '$cmd: Command not found.\n'" if $cmd; } $_; } # Namenergänzung. sub expand { $thisdir = $cwd; undef $out; ( $cmd, $remainder ) = split( ' +', $that, 2 ); if ($remainder) { $remainder =~ s/\\ /\\\\/g; @das = split( ' +', $remainder ); $das = pop(@das); #print TTYOUT "\n$das".'|',"\n"; ### TEST ### $das =~ s/\\\\/\\ /g; # Escape - lash weg. #print TTYOUT "\n$das",'|',"\n"; ### TEST ### if ( $das =~ '~/' ) { $das =~ s#~/#/home/$user/#; } if ( $das =~ m|.+/| ) { # Pfad @pfad = split( '/', $das ); $das = pop(@pfad); $pfad = join( '/', @pfad ); $thisdir .= '/' . $pfad; } elsif ( $das =~ m|^/| ) { # absoluter Pfad. @pfad = split( '/', $das ); $das = pop(@pfad); $pfad = join( '/', @pfad ); $thisdir = $pfad; } opendir( DIR, $thisdir ); @files = grep( !/^\.\.?$/, readdir(DIR) ); @match = (); foreach $file (@files) { if ( $file =~ m|^$das| ) { if ( $file eq $das ) { if ( -d "$thisdir/$file" ) { if ( substr( $remainder, -1, 1 ) ne '/' ) { print TTYOUT '/'; $that .= '/'; } else { print TTYOUT "\n"; # print TTYOUT "\n1 $thisdir\n"; + ### TEST ### system "ls -F $thisdir/$file"; &prompt; print TTYOUT $that; } } else { push( @match, ' ' ) if ( substr( $remainder, -1, 1 ) ne ' ' ); } last; } push( @match, $file ); } } if ( @match > 1 ) { print TTYOUT "\n"; $cnt = 0; $w = shift(@match); $c = 1; while ($c) { foreach $t (@match) { undef $c if ( substr( $w, $cnt, 1 ) ne substr( $t, $cnt, +1 ) ); last unless $c; } last unless $c; $e .= substr( $w, $cnt, 1 ); $cnt++; } $out = substr( $e, length($das) ); $that .= $out; unshift( @match, $w ); # print TTYOUT "2 $thisdir @match $e\n"; + ### TEST ### system "cd $thisdir;ls -Fd $e*"; &prompt; print TTYOUT $that; undef $cnt; undef $e; } else { ($match) = @match; if ($match) { if ( $match eq ' ' ) { $out = ' '; } else { print TTYOUT ( "\010 \010" x length($das) ); $that = substr( $that, 0, ( length($that) - length($das) + ) ); $merkdas = $match; $match =~ s/ /\\ /g; # Meta-Zeichen der Shell e +scapen #$match =~ s/!/\\!/g; $out = $match; if ( -d "$thisdir/$merkdas" ) { $out .= '/'; } else { $out .= ' '; } } print TTYOUT $out; $that .= $out; } } } else { print TTYOUT "\n"; # print TTYOUT "3 $thisdir\n"; + ### TEST ### system "ls -F $thisdir"; &prompt; print TTYOUT $that; } } # Prozesse beenden. sub zap { undef $quit; undef $all; if ($procnt) { print TTYOUT "^L\nSie können jetzt die Ihnen gehörenden Prozesse beenden. +\n"; print TTYOUT "Die Prozesse werden der Reihe nach durchgegangen +,\n"; print TTYOUT "und Sie werden für jeden gefragt, ob Sie ihn beenden wollen +.\n"; print TTYOUT "weiter ? (y|n) >"; read( TTYIN, $ans, 1 ); ++$quit if $ans !~ /^y/i; unless ($quit) { foreach $host ( sort keys(%proc) ) { if ( $proc{$host} ) { @processes = (); @nokill = (); @processes = split( "\n", $proc{$host} ); $thiscnt = @processes; ( $thiscnt > 1 ) ? print TTYOUT "\nAuf $host laufen $thiscnt Prozesse von Ihnen. +\n" : print TTYOUT "\nAuf $host läuft 1 Prozess von Ihnen.\n"; if ( $thiscnt > 1 ) { print TTYOUT "Alle auf einmal beenden oder ein +zeln?\n"; print TTYOUT "(a = alle, e = einzeln, w = nächster Rechner, q = beenden)\n"; print TTYOUT "was tun? >"; read( TTYIN, $ans, 1 ); next if $ans =~ /^w/i; last if $ans =~ /^q/i; if ( $ans =~ /^a/i ) { @zap = (); print TTYOUT "alle\n"; while (@processes) { $here = shift(@processes); ( $thishost, $pid, $rest ) = split( ';', $here, 3 ); $zap = $pid + 1; $pid = $zap - 1; $procnt--; push( @zap, $pid ); } system "rsh $host 'echo @zap | xargs kill +-9'"; } else { print TTYOUT "einzeln\n"; } } while (@processes) { $here = shift(@processes); ( $thishost, $pid, $sz, $start, $command ) = split( ';', $here ); print TTYOUT "\n$command läuft seit $start, belegt $sz kB im Hauptspeicher.\n"; print TTYOUT "(w = nächster Rechner q = beende +n)\n"; print TTYOUT "zapp? (y|n) >"; read( TTYIN, $ans, 1 ); if ( $ans =~ /^y/i ) { print TTYOUT "yes\n"; system "rsh $host kill -9 $pid"; $procnt--; } elsif ( $ans =~ /^w/i ) { print TTYOUT "weiter\n"; unshift( @processes, $here ); last; } elsif ( $ans =~ /^q/i ) { $quit++; unshift( @processes, $here ); last; } else { print TTYOUT "no\n"; unshift( @nokill, $here ); } } $proc{$host} = join( "\n", @processes ); if (@nokill) { $proc{$host} = join( "\n", $proc{$host}, @noki +ll ); $proc{$host} .= "\n"; } last if $quit; } } open( PSOUT, ">/home/$user/.ps$user" ); $cnt = 0; foreach $host ( sort keys(%proc) ) { if ( $proc{$host} ) { print PSOUT $proc{$host}; $cnt++; } } close PSOUT; system "rm $psfile" unless $cnt; print TTYOUT "\n"; } else { print TTYOUT "\n"; } } else { print TTYOUT "Keine alten Prozesse vorhanden.\n"; } } sub cleanup { if ($BSD) { system "stty -cbreak < /dev/$ENV{'TTY'} > /dev/$ENV{'TTY'} 2>& +1"; } else { system "stty", 'icanon'; system "stty", 'eol', '^@'; } } sub size { $i = `du -s $ENV{'HOME'}/`; ($i) = split( ' ', $i ); $i; } sub df { # package df; open( IN, "ypmatch $user auto.home |" ); $t = <IN>; close IN; ( $mist, $rest ) = split( ' +', $t ); ( $mist, $userhome, $rest ) = split( ':', $rest ); $/ = ""; open( IN, "df |" ); while (<IN>) { if (/$userhome\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+%)/) { ( $kbytes, $used, $avail, $capacity ) = ( $1, $2, $3, $4 ) +; } } close IN; $/ = "\n"; ( $kbytes, $used, $avail, $capacity ); $this = <<Endofthis; Festplatte: $userhome\n Kilobytes: $kbytes\n verbraten: $used noch frei: $avail Kapazität: $capacity Endofthis $this; } # VÖLKER HÖRT DIE SIGNALE ... sub hup { print TTYOUT "\nSignal: hup\n"; &prompt; } sub int { print TTYOUT "\nNo way.\n"; &prompt; } sub quit { print TTYOUT "\nNo way.\n"; &prompt; } sub ill { print TTYOUT "\nSignal: ill\n"; &prompt; } sub trap { print TTYOUT "\nSignal: trap\n"; &prompt; } sub iot { print TTYOUT "\nSignal: iot\n"; &prompt; } sub emt { print TTYOUT "\nSignal: emt\n"; &prompt; } sub fpe { print TTYOUT "\nSignal: fpe\n"; &prompt; } sub kill { print TTYOUT "\nSignal: kill\n"; &prompt; } sub bus { print TTYOUT "\nSignal: bus\n"; &prompt; } sub segv { print TTYOUT "\nSignal: segv\n"; &prompt; } sub sys { print TTYOUT "\nSignal: sys\n"; &prompt; } sub pipe { print TTYOUT "\nSignal: pipe\n"; &prompt; } sub alrm { print TTYOUT "\nSignal: alrm\n"; &prompt; } sub term { # &cleanup; # ttykram if ($dufile) { print TTYOUT "\nMoment ... "; $red = $ize; $ize = &size; $red -= $ize; if ( $ize > $limit ) { $mail .= "\nPlattenplatz: $ize kB, Limit: $limit kB\n"; $mail .= "Der Account wurde um $red reduziert.\n" if $red; $mail .= &df; open( IN, "<$dufile" ); $/ = ''; # saufaus $file = <IN>; # alles $file =~ s/(Plattenplatz: )\d+( kB)/$1$ize$2/; open( OUT, ">$dufile" ); print OUT $file; close; } else { system "rm -f $dufile"; } } if ($psfile) { $mail .= "\nBei der Gelegenheit sind nicht beendet worden:\n\n +"; $mail .= "PID HOST COMMAND DATE\n"; open( IN, $psfile ); $/ = "\n"; while (<IN>) { chop; ( $host, $pid, $sz, $date, $command ) = split( ';', $_ ); $mail .= "$pid $host $command $date\n"; } } if ( -e $dufile || -e $psfile ) { $mail .= "\n\nwau, wau,\n\nhund.\n"; # Viele Gruesse, dein +Hund. $mail .= '~.'; # Endmarke open( MAIL, "| mail -s 'hund bellt: $user' $mailto" ); # an + root print MAIL $mail; close MAIL; } print TTYOUT "ciao\n"; sleep 2; exit; } sub urg { print TTYOUT "\nSignal: urg\n"; &prompt; } sub stop { print TTYOUT "\nSignal: stop\n"; &prompt; } sub tstp { print TTYOUT "\nNo way.\n"; &prompt; } sub cont { #print TTYOUT "\nSignal: cont\n"; #&prompt; $_; # mach gar nichts. } #sub chld { # print TTYOUT "\nSignal: chld\n"; # &prompt; #} sub ttin { print TTYOUT "\nSignal: ttin\n"; &prompt; } sub ttou { print TTYOUT "\nSignal: ttou\n"; &prompt; } sub io { print TTYOUT "\nSignal: io\n"; &prompt; } sub xcpu { print TTYOUT "\nSignal: xcpu\n"; &prompt; } sub xfsz { print TTYOUT "\nSignal: xfsz\n"; &prompt; } sub vtalrm { print TTYOUT "\nSignal: vtalrm\n"; &prompt; } sub prof { print TTYOUT "\nSignal: prof\n"; &prompt; } #sub winch { # print TTYOUT "\nhups!\n"; # &prompt; #} sub lost { print TTYOUT "\nSignal: lost\n"; &prompt; } sub usr1 { print TTYOUT "\nSignal: usr1\n"; &prompt; } sub usr2 { print TTYOUT "\nSignal: usr2\n"; &prompt; } ############################################################# # The next few lines are legal in both perl and nroff. .00; 'di \" finish diversion - previous line must be blank .nr % 0 \" start at page 1 .nr nl 0-1 \" fake up transition to first page again ';__END__ #### From here on it's a standard manual page #### .de EX \"Begin example .ne 5 .if n .sp 1 .if t .sp .5 .nf .in +.5i .. .de EE \"End example .fi .in -.5i .if n .sp 1 .if t .sp .5 .. .TH HUND 8 "April 15, 1994" .AT 3 .SH NAME hund \- tcsh-fake; passt auf Festplatte und Process-Tables auf und sor +gt dafuer, dass beide nicht ueberlaufen. .SH SYNOPSIS .B hund [tmp-Verzeichnis] .SH BESCHREIBUNG .I Hund benimmt sich jeweils anders, wenn von root oder jemand anderes gestart +et wird. Laeuft waehrend seiner Ausfuehrung irgendwas schief, so schi +ckt \fIroot-hund\fP eine \fImail\fP an root. .I Hund ist ein Perlscript. .SS 1. DER ROOT HUND sucht auf den rechnern der lokalen Domaene nach nicht abgeschlossenen Prozessen, die irgendwem ausser den Dummy-Usern gehoeren, und aendert +das Environment dieser \fIuser\fP, so dass sie beim naechsten Login a +usser Aufraumen nichts tun koennen. Gleiches tut \fIroot-hund\fP, wenn er im + home - Verzeichnis die Datei .du\fIuser\fP findet, welche beim Ueberschreiten des Plattenplatzes erzeugt wird. .PP .I Root-hund macht das so: .PP Fuer jeden gefundenen \fIuser\fP schreibt \fIroot-hund\fP die gefunden +en Prozesse in die Dateie /home/.ps\fIuser\fP, vorausgesetzt, das Verzeichnis existiert und user ist kein dummy-user. Die Zeilen haben d +as Format: .EX HOST;PID;SZ;START;COMMAND .EE .PP Fuer jeden gefundenen \fIuser\fP benennt der \fIroot-hund\fP die Datei + .xinitrc in .xinitrc.hund um und schreibt eine neue Datei .xinitrc, +in welche vor die Zeile des ersten Auftretens eines Windowmanagers die folgenden drei Zeilen eingefuegt werden: .EX twm -f $0.twmrc & cmdtool $0 $GERAFFELDIR & wait .EE $0 ist der komplette Pfad + der Name, unter dem hund laeuft (weswegen +\fIhund\fP von \fI/\fP aus gestartet werden muss), $0.twmrc die restriktive .twmr +c-Datei, in der diverse Werkzeuge ausgeschaltet sind. Die Variable GERAFFELDIR ist ein temporaeres Verzeichnis (siehe Optionen), in das \fIuser\fP Daten auslagern kann, wenn sein Account ueberzulaufen droht. Die Dateien in diesem Verzeichnis werden zweckmaessigerweise von \fIcr +on(1)\fP verwaltet. .PP Loggt sich \fIuser\fP das naechste mal ein, hat er mit \fIhund\fP zu t +un. .PP .SS 2. DER USER HUND .I Hund ist ein tcsh - Fake, wenn von anderen als root gestartet. Als solcher erlaubt er nur Operationen zur Reduzierung des eigenen Speicherplatzes + und zum beenden noch laufender, nicht abgeschlossenen Prozesse. .nf \fIUser\fP stehen folgende Befehle zur Verfuegung: .PP .nf .in -3.i cd - wechselt ins angegebene Verzeichnis cp - kopiert Dateien compress - komprimiert Dateien mv - verschiebt Dateien / benennt Dateien um ls - gibt den Inhalt des aktuellen Verzeichnisses aus ll - wie ls, aber mit Information ueber Dateityp, Eigner +, Gruppenzugehoerigkeit, Groesse und Datum ln - legt einen Verweis an du - gibt die Groesse des aktuellen Verzeichnisses aus rm - loescht Dateien mkdir - legt ein Verzeichnis an rmdir - loescht leere Verzeichnisse man <befehl> - ruft die Handbuchseite fuer den Befehl <befehl> auf +. fdformat - formatiert eine Diskette fuer MS-DOS mount.pcfs - haengt eine Diskette ins Dateiensystem ein umount.pcfs - haengt die Diskette wieder aus und gibt sie frei prozesse - alte Prozesse beenden ? - gibt diese Liste aus .fi .PP Diese Befehle sind z.T. noch eingeschraenkt. Es ist z.B. nicht moeglic +h, find mit -exec aufzurufen oder Pipes in andere Befehle als die auf +gelisteten zu erstellen. .PP \fIHund\fP ermittelt beim Start die Groesse des Accounts aus der Datei + /home/.du\fIuser\fP oder, falls das fehlschlaegt, mit du -s. .PP .I Hund faengt die Signale TSTP INT QUIT ab. TERM veranlasst ihn, eine \fImai +l\fP an root zu senden, wenn der Account ueber dem Limit liegt oder a +lte Prozesse von \fIuser\fP nicht beendet worden sind, und sich ins K +oerbchen zu trollen. .SH OPTIONEN In der aufrufenden Zeile kann der Pfad eines temporaeren Verzeichnisss +es angegeben werden, in das \fIuser\fP seine Daten auslagern kann. In + diesem Fall wird der \fIhund\fP - internen Hashtabelle der Befehl \f +Istapel\fP hinzugefuegt, und im home - Verzeichnis ein symbolischer l +ink auf dieses Verzeichnis gelegt. \fIstapel\fP entspricht dem alias +der \fItcsh\fP .EX alias stapel 'mv -i \\!* $GERAFFELDIR/$USER/' .EE wobei die Variable GERAFFELDIR natuerlich gesetzt sein muss. .PP .SH FILES .nf hund \- diese Datei hund.cfg \- hund Konfigurationsdatei .SH "SEE ALSO" perl(1), tcsh(1) .SH DIAGNOSTICS wau - hund meldet sich. .SH BUGS Sicherlich fuerchterlich viele. Die Prozesse werden nicht richtig zuru +eckgeschrieben, wenn man im hund Prozesse beendet. Irgendwas fehlt. .SH AUTOR shmem
perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'