#!/usr/local/bin/perl -w my $img_server="daniel.dnd.com.pl"; my $pass="qmail"; use strict; my $home; my $folder; my $kt; my $ile; my $ile_starych; my $ktory; my $fol_wzg; my $fol_wzg_cel; my $login; my $domena; my @du; use Socket; use Carp; my $EOL = "\015\012"; sub spawn; # forward declaration sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } sub sep_par { print "\`\@\`"} my $port = shift || 2345; my $proto = getprotobyname('tcp'); $port = $1 if $port =~ /(\d+)/; # untaint port number socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; logmsg "server started on port $port"; my $waitedpid = 0; my $paddr; sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; # loathe sysV #logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&REAPER; for ( $waitedpid = 0; ($paddr = accept(Client,Server)) || $waitedpid; $waitedpid = 0, close Client) { next if $waitedpid and not $paddr; my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port"; spawn sub { my $line = ; chomp $line; my @param = split (/ /,$line); if ($param[0] eq "folders_stat") { my $mail = $param[1]; ($login, $domena) = split ("@", $mail); &folders_stat; } else {print "error\'=\'UNKNOWN ERROR \;)"} }; } sub spawn { my $coderef = shift; unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { confess "usage: spawn CODEREF"; } my $pid; if (!defined($pid = fork)) { logmsg "cannot fork: $!"; return; } elsif ($pid) { #logmsg "begat $pid"; return; # I'm the parent } # else I'm the child -- go spawn open(STDIN, "<&Client") || die "can't dup client to stdin"; open(STDOUT, ">&Client") || die "can't dup client to stdout"; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; exit &$coderef(); } sub folders_stat { $home = "/home/platna.dnd.com.pl/m/ms11"; my $quota = 10000; &sep_par; $ktory = 4; open (FOL, "ls -1 $home|") || die "can't exec ls -1: $!"; while ($fol_wzg = ) { chomp $fol_wzg; &napraw_fol_wzg; if ($fol_wzg=~/Maildir/) { $kt = 1;&rob_folder;next;} elsif ($fol_wzg=~/outbox/) { $kt = 2;&rob_folder;next;} elsif ($fol_wzg=~/kosz/) { $kt = 3;&rob_folder;next;} else {$kt=$ktory;} &rob_folder; $ktory++; } close (FOL); print "koniec\`=\`koniec"; } sub rob_folder { $ile=0; $ile_starych=0; $folder = $home . "/" . $fol_wzg; open (LISTA, "find $folder -type f|") || die "can't exec find: $!"; while (my $lista = ) { $ile++; if ($lista eq "") {print "Folder pusty\n";exit 6;} if ($lista =~ /S/) { $ile_starych++; } } close (LISTA); print "name_f",$kt,"\`=\`",$fol_wzg; &sep_par; print "all_mail",$kt,"\`=\`",$ile; &sep_par; print "new_mail",$kt,"\`=\`",$ile - $ile_starych; &sep_par; print "read_mail",$kt,"\`=\`",$ile_starych; &sep_par; $folder = $home . "/" . $fol_wzg; # open (DU, "du -s $folder|") || die "can't exec du: $!"; my $temp = `du -s $folder`; #; # close (DU); @du = split (" ",$temp); print "size",$kt,"\`=\`",$du[0] - 16; &sep_par; } sub napraw_fol_wzg { while ($fol_wzg =~ //) {$fol_wzg =~ s//%B6/;} while ($fol_wzg =~ //) {$fol_wzg =~ s//%B1/;} while ($fol_wzg =~ //) {$fol_wzg =~ s//%F3/;} while ($fol_wzg =~ //) {$fol_wzg =~ s//%A6/;} while ($fol_wzg =~ //) {$fol_wzg =~ s//%AC/;} while ($fol_wzg =~ //) {$fol_wzg =~ s//%D3/;} } sub napraw_fol_wzg_cel { while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%B6/;} while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%B1/;} while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%F3/;} while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%A6/;} while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%AC/;} while ($fol_wzg_cel =~ //) {$fol_wzg_cel =~ s//%D3/;} } -- Daniellek