From: tolik@icomm.ru (Anatoly K. Lasareff)
Newsgroups: fido7.ru.perl
Date: 27 Oct 1998 11:53:33 +0300
> >>>>> "AVV" == Alex V Varavva <alexv@vessolink.karelia.ru> writes:
>
> AVV> Вопрос такой - как на perl написать приложение (сервер), которое
> AVV> вешалось бы на определенный порт(сокет), получало бы данные (от
клиента)
> AVV> и затем отправляло подтверждение (клиенту) ?
> >>
> AVV> А то попадаются примеры в которых или одно или другое (только
> AVV> прием/только передача).
> >>
> >> Если ты работаешь под унихом и у тебя есть root права, то по моему
> >> проше повесить соответствующую программу в inetd - при этом сам сервер
> >> читает со стдина, и пишет на стдоут. Только надо не забыть автофлаш на
> >> стдоут.
> >>
>
> AVV> Есть права, есть unix, есть желание сделать, но не знаю как :((
> AVV> Киньте плз пример.
>
примеры клиента и сервера
-- server --------------------------------------------------
#!/usr/local/bin/perl5
$dir = "/home/elma/elma/hemmot";
$opt_d = 0;
($port) = @ARGV;
$port= 2345 unless $port;
$AF_INET = 2;
$SOCK_STREAM = 1;
$EINTR = 4;
$sockaddr = 'S n a4 x8';
sub missa1 {
local($user,$mtime) = @_;
local($message, $nro);
if (-f "$dir/$user/pois") {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat(_);
open (POISSA,"$dir/$user/pois");
if ($message = <POISSA>) {
while (<POISSA>) {
$message .= "\t$_";
}
}
close(POISSA);
} else {
$message = "Paikalla\n"
}
if (-f "$dir/$user/nro") {
open (NRO,"$dir/$user/nro");
$nro = <NRO>;
chop($nro);
close(NRO);
} else {
$nro = ' ';
}
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
($sec1,$min1,$hour1,$mday1,$mon1,$year1,$wday1,$yday1,$isdst1) =
localtime(time);
$dday=$yday1-$yday;
$dday+=($year1-$year)*365;
if ($dday==0) {
$ts = sprintf "%02d.%02d %02d:%02d", $mday,($mon+1),$hour,$min;
} elsif ($dday==1) {
$ts = sprintf "eilen %02d.%02d %02d:%02d", $mday,($mon+1),$hour,$min;
} elsif ($dday==2) {
$ts = sprintf "toissapnД %02d.%02d %02d:%02d", $mday,($mon+1),$hour,$min;
} else {
$ts = sprintf "%d pДivДД sitten %02d.%02d %02d:%02d",
$dday,$mday,($mon+1),$hour,$min;
}
print NS "$nro\t$user\t$ts\t$message";
($opt_d) && print "Done $user\n";
}
sub missa {
local($user) = @_;
if ($user) {
if ($user =~ /^[a-z]+$/ && -d "$dir/$user") {
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat(_);
missa1 ($user, $mtime);
} else {
print NS "Unknown user!\n";
}
} else {
opendir (D, "$dir/") || return;
@d = readdir (D);
closedir (D);
@d = sort (@d);
foreach $fname (@d) {
if ($fname =~ /^[a-z]+$/ && ! -l "$dir/$fname" && -d "$dir/$fname") {
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat(_);
missa1 ($fname, $mtime);
}
}
}
}
($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {
($name, $aliases, $port) = getservbyport($port, 'tcp');
}
($opt_d) && print "Port = $port\n";
$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
select(NS); $| = 1; select(stdout);
socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
bind(S,$this)|| die "bind: $!";
listen(S,5) || die "connect: $!";
select(S); $| = 1; select(stdout);
sub waitforc {
wait;
($opt_d) && printf("waited\n");
$SIG{'CHLD'} = 'waitforc';
}
$SIG{'CHLD'} = 'waitforc';
for($con = 1; ;$con++) {
($opt_d) && printf("Listening for connection %d.....\n", $con);
while (!($addr = accept(NS,S))) {
die $! unless $EINTR == $!;
}
if (($child = fork()) == 0) {
($opt_d) && print "accept ok\n";
($af, $port, $inetaddr) = unpack($sockaddr, $addr);
@inetaddr = unpack('C4',$inetaddr);
($opt_d) && print "$con: $af $port @inetaddr\n";
# jaakko 1996-06-06 no more looping, just process 1 command
if ($_ = <NS>) {
($command, $user, @args) = split;
($opt_d) && print "$con: $_";
$lookdir = "$dir/$user";
if (! -d $lookdir) {
print NS "Unknown user\n";
} elsif ($command eq "MISSA") {
missa ($user);
} elsif ($command eq "POIS") {
if (!@args) {
unlink("$lookdir/pois");
} else {
open (POISSA, ">$lookdir/pois");
print POISSA "@args\r\n";
close (POISSA);
chown (28,1,"$lookdir/pois") ;
}
}
}
close(NS);
($opt_d) && print "$con: exiting\n";
exit;
}
close(NS);
}
-- client --------------------------------------------------
#!/usr/local/bin/perl
$user = $ARGV[0];
$port = 2345 unless $port;
$them = 'localhost' unless $them;
$opt_d = 0;
# die "Usage: M <user>\n" unless $user;
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';
chop($hostname = `hostname -s`);
($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $port) = getservbyport($port, 'tcp')
unless $port =~ /^\d+$/;;
($name, $alias, $type, $len, $thisaddr) = gethostbyname($hostname);
($name, $alias, $type, $len, $thataddr) = gethostbyname($them);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);
if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
($opt_d) && print "socket ok\n";
} else {
die $!;
}
if (connect(S, $that)) {
($opt_d) && print "$connect ok\n";
} else {
die $!;
}
select(S); $| = 1; select (STDOUT);
print S "MISSA $user\n";
while(<S>) {print;}
close S;
--------------------------------------------------
WBW, Artur
-- end of forwarded message --
--
С тем, что не помешает никогда,
Kittle