in reply to Re: Attempt to free unreferenced scalar...
in thread Attempt to free unreferenced scalar...
#!/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 = <STDIN>; 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 = <FOL>) { chomp $fol_wzg; &napraw_fol_wzg; if ($fol_wzg=~/Maildir/) { $kt = 1;&rob_folder +;next;} elsif ($fol_wzg=~/outbox/) { $kt = 2;&rob_fold +er;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 = <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`; #<DU>; # close (DU); @du = split (" ",$temp); print "size",$kt,"\`=\`",$du[0] - 16; &sep_par; } sub napraw_fol_wzg { while ($fol_wzg =~ /<B6>/) {$fol_wzg =~ s/<B6>/%B6/;} while ($fol_wzg =~ /<B1>/) {$fol_wzg =~ s/<B1>/%B1/;} while ($fol_wzg =~ /<F3>/) {$fol_wzg =~ s/<F3>/%F3/;} while ($fol_wzg =~ /<A6>/) {$fol_wzg =~ s/<A6>/%A6/;} while ($fol_wzg =~ /<AC>/) {$fol_wzg =~ s/<AC>/%AC/;} while ($fol_wzg =~ /<D3>/) {$fol_wzg =~ s/<D3>/%D3/;} } sub napraw_fol_wzg_cel { while ($fol_wzg_cel =~ /<B6>/) {$fol_wzg_cel =~ s/<B6>/%B6/;} while ($fol_wzg_cel =~ /<B1>/) {$fol_wzg_cel =~ s/<B1>/%B1/;} while ($fol_wzg_cel =~ /<F3>/) {$fol_wzg_cel =~ s/<F3>/%F3/;} while ($fol_wzg_cel =~ /<A6>/) {$fol_wzg_cel =~ s/<A6>/%A6/;} while ($fol_wzg_cel =~ /<AC>/) {$fol_wzg_cel =~ s/<AC>/%AC/;} while ($fol_wzg_cel =~ /<D3>/) {$fol_wzg_cel =~ s/<D3>/%D3/;} } -- Daniellek
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Attempt to free unreferenced scalar...
by Dominus (Parson) on Nov 30, 2000 at 19:46 UTC | |
by Daniellek (Sexton) on Dec 01, 2000 at 15:01 UTC | |
by Dominus (Parson) on Dec 01, 2000 at 18:40 UTC | |
by Daniellek (Sexton) on Dec 07, 2000 at 20:02 UTC | |
by Dominus (Parson) on Dec 10, 2000 at 07:21 UTC | |
| |
|
Re: Re: Re: Attempt to free unreferenced scalar...
by Fastolfe (Vicar) on Dec 10, 2000 at 07:35 UTC | |
by Daniellek (Sexton) on Dec 11, 2000 at 16:32 UTC | |
by Daniellek (Sexton) on Dec 11, 2000 at 18:45 UTC | |
by Fastolfe (Vicar) on Dec 11, 2000 at 19:46 UTC |