#!/usr/local/bin/perl -w # # Unpublished Test Version # $version="2.6.1IM"; # # (c) 1997 Emmanuel PIERRE # epierre@mail.esiea.fr # http://www.esiea.fr/public_html/Emmanuel.PIERRE # # Developed at/by: # Ecole Supérieure d'Informatique-Electronique-Automatique # a project of the School Intranet Web Server # # http://hp1.esiea.fr:2001 # # require 5.002; #use strict; use strict 'subs'; BEGIN { $ENV{PATH} = '/usr/bin:/bin' } use IO::Socket; use IO::Handle; use Carp; use Net::Domain qw(hostname hostfqdn hostdomain); use Net::Ping; use Fcntl; sub spawn; # forward declaration sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n" } my $waitedpid = 0; my $paddr; my $serv_port=12345; my $server_name = "http://www.esiea.fr:8080"; my $pere_pid=$$; &Init_Server; &Sig_Intercept; &Wait_Connection; exit; sub Wait_Connection { # # Boucle d'attente de connection # for ( $waitedpid = 0; ($paddr = accept(Client,Server)) || $waitedpid; $waitedpid = 0, close Client) { #next if $waitedpid; my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port"; spawn sub { &gere_connection(*Client); }; } } sub gere_connection { # # Routine de gestion d'une connection # local(*Client) = $_[0]; my $counter=0; my $buffer=""; my $inbuffer=""; my ($res,$serv,$port); my $charger=`/usr/bin/uptime`; my ($charge)=($charger=~/average:\s(\d*\.\d+)/); local $ftime = localtime (time); $buffer="[$charge][$hostname] MoXWorld Agent Server v$version (C)Emmanuel PIERRE 1997\n"; my $code_ret=0; while (1) { # last if (sysread(Client, $buffer, 512)<=0); if (sysread(Client, $inbuffer, 512)<=0) { &close_all; } #code_ret = recv(Client, $buffer, 512,0); print STDOUT "Recu : >", $inbuffer, "<\n"; # bricolage pour mauvaise connection... #$counter++; #if ($counter>10) { # &close_all; #} #last if ($inbuffer =~ /BYE/); last if ($inbuffer eq "BYE\r\n"); if (($inbuffer=~ /GET \/SHUTDOWN/)) { kill('USR2',$pere_pid); #print "kill USR2 $pere_pid\n"; &close_all; } if ($inbuffer =~ /GET \/IDENT/) { $buffer.="IDENT= $hostname:$serv_port\r\n\r\n"; syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /HEAD/) { $buffer="HTTP/1.1 200 OK\r\nDate: $ftime\r\nServer: MoXWorld Agent Server v$version\r\nConnection: close\r\nContent-Type: text/html\r\n\r\n"; syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \/pages/) { # # Moulinette # &get_pages; foreach $id (keys %pageres) { $buffer.="$pageres{$id}\n"; } syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \/activ/) { # # Moulinette # &get_activ; foreach $id (keys %activres) { $buffer.="$activres{$id}\n"; } syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \/proj/) { # # Moulinette # &get_proj; foreach $id (keys %projres) { $buffer.="$projres{$id}\n"; } syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \/cv/) { # # Moulinette # &get_cv; foreach $id (keys %cvres) { $buffer.="$cvres{$id}\n"; } syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \/dob/) { # # Moulinette # &get_dob; foreach $id (keys %dobres) { (@liste)=split(/\n/,$dobres{$id}); while (@liste) { $loc=pop(@liste); $buffer.="$id\t$loc\n"; } } syswrite(Client, $buffer, length($buffer)); last; } if ($inbuffer =~ /GET \//) { if ($inbuffer=~ /\.gif/) { ($fic)=($inbuffer=~/\/(.*\.gif)/); #$buffer="Content-Type: image/gif\r\n\r\n"; $buffer=""; open(FIC,$fic); while () { $buffer.=$_; } close(FIC); #print "-$buffer-\n"; } else { $buffer="\r\nMoXWorld Agent Server v$version\r\n\r\n

MoXWorld Agent Server v$version

\r\n

\r\nThis is our experimental Distributed User Agent, see documentation at Emmanuel PIERRE home page.\r\n\r\n"; } syswrite(Client, $buffer, length($buffer)); last; } $buffer= "\r\n400 Bad Request\r\n\r\n

Bad Request

\r\nYour browser sent a request that\r\nthis server could not understand.

\r\n\r\n"; syswrite(Client, $buffer, length($buffer)); last; } #print "Closing connection.\n"; close(Client); } sub get_pages { # Read the real name from passwd file open(PW,"/etc/passwd"); while () { chop; ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/); ($real) = split(/,/, $gcos); if ($uid>10) { push @tliste, $user.":".$real.":".$dir."\n"; } } close(PW); @tliste = sort @tliste; @tliste = reverse @tliste; while (@tliste) { ($user,$real,$dir)=split(/:/,pop @tliste); chomp($dir); chomp($real); chomp($user); $nom=""; $url=""; if (-r $dir."/.webpagelist") { # si on a affaire à une liste open(FIC,$dir."/.webpagelist"); while() { chomp; ($nom,$real,$url,$logo)=split(/\t/,$_); chomp($nom); chomp($url); chomp($real); chomp($logo); if ($url ne "") { $pageres{$nom}="$nom\t$url\t$real\n"; #print "1-$pageres{$nom}"; } } close(FIC); } else { if (-r $dir."/.webredirect") { open(FIC,$dir."/.webredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/public_html/page/index.html") { $url="$server_name/~$user/page/index.html"; } elsif (-r $dir."/public_html/index.html") { $url="$server_name/~$user/index.html"; } elsif (-r $dir."/Welcome.html") { $url="$server_name$dir/Welcome.html"; } if ($url ne "") { $pageres{$user}="$user\t$url\t$real\n"; #print "2-$pageres{$user}"; } } } } } sub get_cv { # Read the real name from passwd file open(PW,"/etc/passwd"); while () { chop; ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/); ($real) = split(/,/, $gcos); if ($uid>10) { push @tliste, $user.":".$real.":".$dir."\n"; } } close(PW); @tliste = sort @tliste; @tliste = reverse @tliste; while (@tliste) { ($user,$real,$dir)=split(/:/,pop @tliste); chomp($dir); chomp($real); chomp($user); $nom=""; $url=""; if (-r $dir."/.webcvlist") { # si on a affaire à une liste open(FIC,$dir."/.webcvlist"); while() { chomp; ($nom,$real,$url,$logo)=split(/\t/,$_); chomp($nom); chomp($url); chomp($real); chomp($logo); if ($url ne "") { $cvres{$nom}="$nom\t$url\t$real\n"; #print "1-$cvres{$nom}"; } } close(FIC); } else { if (-r $dir."/.webcvredirect") { open(FIC,$dir."/.webcvredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/cv.html") { $url="$server_name$dir/cv.html"; } if (-r $dir."/public_html/cv/index.html") { $url="$server_name/~$user/cv/index.html"; } if ($url ne "") { $cvres{$user}="$user\t$url\t$real\n"; #print "2-$cvres{$user}"; } } } } } sub get_activ { # Read the real name from passwd file open(PW,"/etc/passwd"); while () { chop; ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/); ($real) = split(/,/, $gcos); if ($uid>10) { push @tliste, $user.":".$real.":".$dir."\n"; } } close(PW); @tliste = sort @tliste; @tliste = reverse @tliste; while (@tliste) { ($user,$real,$dir)=split(/:/,pop @tliste); chomp($dir); chomp($user); chomp($real); $nom=""; $logo=""; $url=""; if (-r $dir."/.webactivlist") { # si on a affaire à une liste open(FIC,$dir."/.webactivlist"); while() { chomp; ($nom,$url,$logo)=split(/\t/,$_); chomp($nom); chomp($url); chomp($logo); if ($url ne "") { $activres{$nom}="$nom\t$url\t$logo\n"; #print "1-$activres{$nom}"; } } close(FIC); } else { if (-r $dir."/.webactivname") { open(FIC,$dir."/.webactivname"); $nom=; close(FIC); chomp($nom); if (-r $dir."/.webactivredirect") { open(FIC,$dir."/.webactivredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/public_html/activ/index.html") { $url="$server_name/~$user/activ/index.html"; } } if (-r $dir."/public_html/activ/minilogo.gif") { $logo="$server_name/~$user/activ/minilogo.gif"; } if ($url ne "") { $activres{$nom}="$nom\t$url\t$logo\n"; #print "2-$activres{$nom}"; } } if ((-r $dir."/.webtpfhname")) { open(FIC,$dir."/.webtpfhname"); $nom=; close(FIC); chomp($nom); if (-r $dir."/.webtpfhredirect") { open(FIC,$dir."/.webtpfhredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/public_html/tpfh/index.html") { $url="$server_name/~$user/tpfh/index.html"; } } if (-r $dir."/public_html/tpfh/minilogo.gif") { $logo="$server_name/~$user/tpfh/minilogo.gif"; } if ($url ne "") { $activres{$nom}="$nom\t$url\t$logo\n"; #print "3-$activres{$nom}"; } } } } } sub get_proj { # Read the real name from passwd file open(PW,"/etc/passwd"); while () { chop; ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/); ($real) = split(/,/, $gcos); if ($uid>10) { push @tliste, $user.":".$real.":".$dir."\n"; } } close(PW); @tliste = sort @tliste; @tliste = reverse @tliste; while (@tliste) { $nom=""; $logo=""; ($user,$real,$dir)=split(/:/,pop @tliste); chomp($dir); chomp($real); chomp($user); if (-r $dir."/.webprojlist") { # si on a affaire à une liste open(FIC,$dir."/.webprojlist"); while() { chomp; ($nom,$url,$logo)=split(/\t/,$_); chomp($nom); chomp($url); chomp($logo); if ($url ne "") { $projres{$nom}="$nom\t$url\t$logo\n"; #print "1-$projres{$nom}"; } } close(FIC); } else { if (-r $dir."/.webprojname") { open(FIC,$dir."/.webprojname"); $nom=; close(FIC); chomp($nom); if (-r $dir."/.webprojredirect") { open(FIC,$dir."/.webprojredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/public_html/proj/index.html") { $url="$server_name/~$user/proj/index.html"; } } if (-r $dir."/public_html/proj/minilogo.gif") { $logo="$server_name/~$user/proj/minilogo.gif"; } if ($url ne "") { $projres{$nom}="$nom\t$url\t$logo\n"; #print "2-$projres{$nom}"; } } } } } sub get_dob { # Read the real name from passwd file open(PW,"/etc/passwd"); while () { chop; ($user,$pw,$uid,$gid,$gcos,$dir) = split(/:/); ($real) = split(/,/, $gcos); if ($uid>10) { push @tliste, $user.":".$real.":".$dir."\n"; } } close(PW); @tliste = sort @tliste; @tliste = reverse @tliste; while (@tliste) { ($user,$real,$dir)=split(/:/,pop @tliste); chomp($dir); chomp($real); chomp($user); my $dater=""; my $nom=""; my $url=""; my $email=""; my $d1=""; my $d2=""; my $d3=""; my $DOB=""; if (-r $dir."/.webDOBlist") { # si on a affaire à une liste open(FIC,$dir."/.webDOBlist"); while() { chomp; ($DOB,$nom,$url,$email)=split(/\t/,$_); ($d1,$d2,$d3)=split(/ /,$DOB); $dater="$d2 $d1 $d3"; if (($nom ne "")&&($dater ne "")) { $dobres{$dater}.="$nom\t$url\t$email\n"; #print "1-$hash{$dater}"; } } close(FIC); } else { if (-r $dir."/public_html/perso/DOB") { open(FIC,$dir."/public_html/perso/DOB"); $DOB=; close(FIC); chomp($DOB); ($d1,$d2,$d3)=split(/ /,$DOB); $dater="$d2 $d1 $d3"; $email="$user\@$hostname"; chomp($email); if (-r $dir."/.webredirect") { open(FIC,$dir."/.webredirect"); $url=; close(FIC); chomp($url); } else { if (-r $dir."/Welcome.html") { $url="$server_name$dir/Welcome.html"; } if (-r $dir."/public_html/index.html") { $url="$server_name/~$user/index.html"; } } chomp($dater); if ($dater ne " ") { $dobres{$dater}.="$real\t$url\t$email\n"; #print "2-$hash{$dater}"; } } } } } sub close_all { shutdown(Client, 2); shutdown(Server, 2); #print "Server shutdown... Goodbye.\n"; exit(0); } sub close_cli { shutdown(Server, 2); #print "Server shutdown... Goodbye.\n"; exit(0); } sub timeout { $SIG{ALRM} = \&timeout; print "Socket Timeout\n"; close(S); } sub spawn { # # Spawning de base # 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 exit &$coderef(); } sub REAPER { $SIG{CHLD} = \&REAPER; # loathe sysV $waitedpid = wait; logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); } sub Sig_Intercept { # # Traitement des signaux # $SIG{'INT'} = 'close_all'; $SIG{'QUIT'} = 'close_all'; $SIG{'USR2'} = 'close_all'; $SIG{'PIPE'} = 'close_cli'; $SIG{'TERM'} = 'close_cli'; $SIG{CHLD} = \&REAPER; } sub log_pid { open(FICA,">./srv.pid"); print FICA "$$\n"; close(FICA); } sub Init_Server { # # Initialisation du serveur # &log_pid; $hostname=&hostfqdn(); chomp($hostname); $serv_port = shift || 12345; my $proto = getprotobyname('tcp'); socket(Server, AF_INET, SOCK_STREAM, $proto) || die "socket: $!"; #fcntl(Server,F_SETFL, O_NDELAY); setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($serv_port, INADDR_ANY)) || die "bind: $!" ; listen(Server,SOMAXCONN) || die "listen: $!"; logmsg "server started on port $serv_port"; } sub Connect_server { # # Connecion à un autre serveur # my $server = $_[0]; my $port = $_[1]; my $cmd = $_[2]; return if not (pingecho($server,10)); print "Connecting to $server:$port for $cmd\n"; $cmd .= "\r\n"; my $res = ""; my ($name,$aliases,$proto,$len,$thisadr,$thatadr,$this,$that,$sockaddr,$result); $sockaddr = 'S n a4 x8'; chomp($hostname = `/bin/hostname`); ($name, $aliases, $proto) = getprotobyname('tcp'); ($name, $aliases, $port) = getservbyname($port, 'tcp') unless $port =~ /^\d+$/; ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname); ($name, $aliases, $type, $len, $thataddr) = gethostbyname($server); $this = pack($sockaddr, &AF_INET, 0, $thisaddr); $that = pack($sockaddr, &AF_INET, $port, $thataddr); if (!(socket(S, &PF_INET, &SOCK_STREAM, $proto))) { warn "socket: $!\n"; return "socket: $!\n"; } if (!(bind(S, $this))) { warn "bind: $!\n"; return "bind: $!\n"; } if (!(connect(S, $that))) { warn "connect: $!\n"; return "connect: $!\n"; } select(S); $| = 1; select(STDOUT); # $SIG{ALRM} =\&timeout; # alarm 10; syswrite(S,$cmd,length($cmd)); last if (sysread(S, $buffer, 512)<=0); while ($buffer ne "") { print $buffer; $res.= $buffer; last if ($buffer=~/\r\n\r\n/); last if (sysread(S, $buffer, 512)<=0); # syswrite(S, "BYE\r\n", 5); } shutdown(S,2); # alarm 0; #print "---------------\n$res\n---------------\n"; #my @tab=split(/\r\n/,$res); #pop @tab; #pop @tab; ($result)=($res =~ m/IDENT= (.*)\r\n/m); #print "---------------\n$result\n---------------\n"; return($result); }