Return to getties.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/getties.pl, revision 1.1

1.1     ! albertel    1: use strict;
        !             2: my $result=`ls -l /proc/*/fd/* | grep /home/httpd/perl/tmp/`;
        !             3: my @result=split("\n",$result);
        !             4: my (@pids,@files);
        !             5: foreach my $line (@result) {
        !             6: 	if ($line=~m-/proc/(\d+)/fd-) {
        !             7: 		push(@pids,$1);
        !             8: 		$line=~m-(/home/httpd/perl/tmp/.*)-;
        !             9: 		push(@files,$1);
        !            10: 	}
        !            11: }
        !            12: 
        !            13: $result=`wget --http-user=lonadm -q --http-passwd=litelite --output-document=- http://localhost/server-status`;
        !            14: 
        !            15: @result=split('<tr>',$result);
        !            16: 
        !            17: foreach my $line (@result) {
        !            18: 	if ($line =~ m -</b><td>(\d+)<td>-) {
        !            19: 		my $curpid=$1;
        !            20: 		print ("curpid is $1\n");
        !            21: 		for (my $i=0;$i<=$#pids;$i++) {
        !            22: 			my $pid=@pids[$i];
        !            23: 			my $file=@files[$i];
        !            24: 			if ($curpid == $pid) {
        !            25: 				$line=~m-<td nowrap>([^<]*)</tr>-;
        !            26: 				print("$pid has a tmp file $file, last known request is $1\n");
        !            27: 			}
        !            28: 		}
        !            29: 	}
        !            30: }
        !            31: