summaryrefslogtreecommitdiffstats
path: root/lib/Qooxdoo/Services/tr.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Qooxdoo/Services/tr.pm')
-rw-r--r--lib/Qooxdoo/Services/tr.pm295
1 files changed, 0 insertions, 295 deletions
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;
-
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-05-20 08:32:19 +0200