From 55490b1bfb539386b63e25a8fd90e56c0200c1e8 Mon Sep 17 00:00:00 2001 From: Tobi Oetiker Date: Tue, 23 Aug 2011 13:59:15 +0000 Subject: clean out smoketrace --- lib/Qooxdoo/Services/tr.pm | 295 --------------------------------------------- 1 file changed, 295 deletions(-) delete mode 100644 lib/Qooxdoo/Services/tr.pm (limited to 'lib/Qooxdoo/Services/tr.pm') diff --git a/lib/Qooxdoo/Services/tr.pm b/lib/Qooxdoo/Services/tr.pm deleted file mode 100644 index d78070c..0000000 --- a/lib/Qooxdoo/Services/tr.pm +++ /dev/null @@ -1,295 +0,0 @@ -package Qooxdoo::Services::tr; -use strict; -use POSIX qw(setsid); -use Time::HiRes qw(usleep); -use Socket; - -my $variant = 'butskoy'; -my $config = { - # Modern traceroute for Linux, version 2.0.9, Nov 19 2007 - # Copyright (c) 2006 Dmitry Butskoy, License: GPL - butskoy => [ - { - arg => '-q', - type => 'static', - }, - { - arg => '1', - type => 'static', - }, - { - key => 'host', - type => 'intern', - }, - { - key => 'pkglen', - label => 'Packetlength', - type => 'spinner', - min => 0, - max => 1024, - default => 53, - }, - { - key => 'method', - arg => '-M', - label => 'Traceroute Method', - type => 'select', - pick => [ - default => 'Classic UDP', - icmp => 'ICMP ECHO', - tcp => 'TCP Syn', - udp => 'UDP to port 53', - udplite => 'UDPLITE Datagram', - ], - default => 'icmp', - }, - { - key => 'nofrag', - arg => '-F', - label => 'Do not Fragment', - type => 'boolean', - default => 0, - }, - ], - # Version 1.4a12 - lbl => [ - { - arg => '-q', - type => 'static', - }, - { - arg => '1', - type => 'static', - }, - { - key => 'host', - type => 'intern', - }, - { - key => 'pkglen', - label => 'Packetlength', - type => 'spinner', - min => 0, - max => 1024, - default => 53, - }, - { - key => 'icmpecho', - arg => '-I', - label => 'Use ICMP ECHO', - type => 'boolean', - default => 1, - } - ] -}; - -sub GetAccessibility { - my $method = shift; - my $access = shift; - my $session = shift; -# if ($method eq 'auth' or $session->param('authenticated') eq 'yes'){ - return 'public'; -# } -# else { -# return 'fail'; -# } -} - -sub launch { - my $error = shift; - my $task = shift; - my $cfg = $config->{$variant}; - my @exec; - for (my $i = 0;$i < @{$cfg};$i++){ - my $ch = $cfg->[$i]; - if ($ch->{key}){ - if ($task->{$ch->{key}}){ - if ($ch->{arg}){ - push @exec, $ch->{arg}; - } - push @exec, $task->{$ch->{key}} - } - } - elsif ($ch->{arg}){ - push @exec, $ch->{arg}; - }; - } - use Data::Dumper; - my $rounds = $task->{rounds}; - my $delay = $task->{delay}; -# warn Dumper '### task: '.$task; - defined(my $pid = fork) or do { $error->set_error(101,"Can't fork: $!");return $error}; - if ($pid){ - open my $x, ">/tmp/tr_session.$pid" or do { - $error->set_error(199,"Opening /tmp/tr_session.$$: $!"); - return $error; - }; - close ($x); - return $pid; - } - local $SIG{CHLD}; - chdir '/' or die "Can't chdir to /: $!"; - -# $|++; # unbuffer - open STDOUT, ">>/tmp/tr_session.$$" - or die "Can't write to /tmp/tr_session.$$: $!"; - open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; - setsid or die "Can't start a new session: $!"; - open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; - for (my $i = 0; $i<$rounds;$i++){ - my $start = time; - system "traceroute",@exec; - if ($? == -1) { - print "ERROR: failed to execute traceroute: $? $!\n"; - exit 1; - } - elsif ($? & 127) { - printf "ERROR: traceroute died with signal %d, %s coredump\n", - ($? & 127), ($? & 128) ? 'with' : 'without'; - exit 1; - } - elsif ($? != 0) { - printf "ERROR: traceroute exited with value %d\n", $? >> 8; - exit 1; - } - my $wait = $delay - (time - $start); - if ($wait > 0 and $i+1< $rounds){ - print "SLEEP $wait\n"; - sleep $wait; - } - } - exit 0; -} - -sub get_number { - my $error = shift; - my $data = shift; - $data = 'Undefined' unless defined $data; - if ($data =~ /^(\d+)$/){ - return $1; - } - else { - $error->set_error(104,"Expected a number but got: $data"); - return $error; - } -} - -sub method_stop_tr { - my $error = shift; - my $arg = shift; - my $handle = get_number($error,$arg); - - return $handle if ref $handle; - my $data = "/tmp/tr_session.".$handle; - if (-r $data){ - warn "Sending kill $handle"; - if (kill('KILL',$handle)){ - waitpid($handle,0); - } - } - return 'ok'; -} - - -sub method_start -{ - my $error = shift; - my $arg = shift; - my $session = $error->{session}; - if ($arg->{host}){ - my $delay = get_number($error,$arg->{delay}); - return $delay if ref $delay; - my $rounds = get_number($error,$arg->{rounds}); - return $rounds if ref $rounds; - return launch ($error,$arg); - } - $error->set_error(103,"No host set"); - return $error; -} - - -sub method_poll -{ - my $error = shift; - my $arg = shift; - my $session = $error->{session}; - my %return; - for my $pid (sort keys %$arg){ - my $point = $arg->{$pid}; - my $data = "/tmp/tr_session.".$pid; - my $problem = ''; - if (open my $fh,$data){ - my $again; - my @array; - my $rounds = 0; - waitpid($pid,1); - $again = kill(0, $pid); - my $size = -s $fh; - if ($point < $size and seek $fh, $point,0){ - while (<$fh>){ - next if /^\s*$/ or /^traceroute to/; - if (/^\s*(\d+)\s+(\S+)\s+\((\S+?)\)\s+(\S+)\s+ms/){ - my ($hop,$host,$ip,$value) = ($1,$2,$3,$4); - $value = undef unless $value =~ /^\d+(\.\d+)?$/; - push @array, [$hop,$host,$ip,$value]; - } - elsif (/^\s*(\d+)\s+\*/){ - push @array, [$1,undef,undef,undef]; - } - else { - s/ERROR:\s*//; - $problem .= $_; - } - } - $arg->{$pid} = tell($fh); - $return{$pid}{data} = \@array; - }; - close $fh; - warn 'problem: '.$problem; - if ($problem){ - $return{$pid}{type} = 'error'; - $return{$pid}{msg} = $problem; - delete $arg->{$pid}; - unlink $data; - } - elsif (not $again) { - $return{$pid}{type} = 'state'; - $return{$pid}{msg} = 'idle'; - delete $arg->{$pid}; - unlink $data; - } - } - else { - $return{$pid}{type} = 'error'; - $return{$pid}{msg} = "Opening $data: $!"; - delete $arg->{$pid}; - } - } - $return{handles} = $arg; - return \%return; -} - -sub method_auth { - my $error = shift; - my $user = shift; - my $password = shift; - my $session = $error->{session}; - if ($user eq 'tobi' and $password eq 'robi'){ - $session->param('authenticated','yes'); - } -} - -sub method_get_config { - my $error = shift; - my @list; - for (my $i=0;defined $config->{$variant}[$i]; $i+=2){ - next if not defined $config->{$variant}[$i+1]{label}; - push @list, $config->{$variant}[$i],$config->{$variant}[$i+1]; - }; - return \@list; -} - - - -1; - -- cgit v1.2.3-24-g4f1b