rt/msrserv.pl
author Florian Pose <fp@igh-essen.com>
Fri, 16 Dec 2005 16:22:19 +0000
branchkernel-2.4
changeset 1762 fd8b9ad48f88
parent 0 05c992bf5847
child 28 801dc7eabf51
permissions -rwxr-xr-x
user-Implementation aus 2.4er Branch entfernt.
0
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     1
#!/usr/bin/perl -w
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     2
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     3
# Multithreaded Server 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     4
# according to the example from "Programming Perl"
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     5
#
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     6
# works with read/write on a device-file  
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     7
#
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     8
# $Revision: 1.1 $
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     9
# $Date: 2002/07/09 10:10:59 $
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    10
# $RCSfile: msrserv.pl,v $
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    11
#
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    12
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    13
require 5.002;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    14
use strict;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    15
BEGIN { $ENV{PATH} = '/usr/bin:/bin' }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    16
use Socket;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    17
use Carp;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    18
use FileHandle;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    19
use Getopt::Std; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    20
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    21
use Sys::Syslog qw(:DEFAULT setlogsock); 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    22
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    23
use vars qw (
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    24
	     $self $pid $dolog $port $dev %opts $selfbase
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    25
	     $len $offset $stream $written $read $log $blksize
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    26
	     $authfile %authhosts
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    27
	     );
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    28
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    29
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    30
# Do logging to local syslogd by unix-domain socket instead of inetd
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    31
setlogsock("unix");  
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    32
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    33
# Prototypes and some little Tools
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    34
sub spawn;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    35
sub logmsg { 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    36
  my ($level, @text) = @_;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    37
  syslog("daemon|$level", @text) if $dolog;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    38
#  print STDERR "daemon|$level", @text, "\n" if $dolog;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    39
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    40
sub out {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    41
  my $waitpid = wait; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    42
  logmsg("notice", "$waitpid exited");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    43
  unlink "$selfbase.pid";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    44
  exit 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    45
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    46
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    47
sub help {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    48
  print "\n  usage: $0 [-l og] [-h elp] [-p port] [-d device]\n"; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    49
  exit; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    50
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    51
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    52
# Process Options
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    53
%opts = (
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    54
	 "l" => 1,
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    55
	 "h" => 0,
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    56
	 "p" => 2345,
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    57
	 "d" => "/dev/msr"
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    58
	 );
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    59
  
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    60
getopts("lhp:d:", \%opts);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    61
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    62
help if $opts{"h"};
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    63
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    64
( $self =  $0 ) =~ s+.*/++ ;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    65
( $selfbase = $self ) =~ s/\..*//;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    66
$log = "$selfbase.log";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    67
$dolog = $opts{"l"};
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    68
$port = $opts{"p"};
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    69
$dev = $opts{"d"};
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    70
$blksize = 1024; # try to write as much bytes
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    71
$authfile = "/opt/kbw/etc/hosts.auth"; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    72
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    73
# Start logging
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    74
openlog($self, 'pid');
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    75
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    76
# Flush Output, dont buffer
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    77
$| = 1;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    78
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    79
# first fork and run in background
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    80
if ($pid = fork) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    81
#  open LOG, ">$log" if $dolog;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    82
#  close LOG;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    83
  logmsg("notice", "forked process: $pid\n");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    84
  exit 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    85
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    86
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    87
# Server tells about startup success
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    88
open (PID, ">$selfbase.pid");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    89
print PID "$$\n";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    90
close PID;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    91
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    92
# Cleanup on exit (due to kill -TERM signal)
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    93
$SIG{TERM} = \&out;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    94
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    95
# We use streams
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    96
my $proto = getprotobyname('tcp');
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    97
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    98
# Open Server socket
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    99
socket(Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   100
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   101
  or die "setsocketopt: $!";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   102
bind (Server, sockaddr_in($port, INADDR_ANY))
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   103
  or die "bind: $!";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   104
listen (Server, SOMAXCONN) 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   105
  or die "listen: $!";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   106
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   107
%authhosts = ();
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   108
# get authorized hosts
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   109
open (AUTH, $authfile) 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   110
  or logmsg ("notice", "Could not read allowed hosts file: $authfile");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   111
while (<AUTH>) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   112
    chomp;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   113
    my $host = lc $_;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   114
    logmsg ("notice", "Authorized host: $host");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   115
    $authhosts{$_} = 1 if $host =~ /^[\d\w]/;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   116
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   117
close (AUTH);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   118
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   119
# tell about open server socket
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   120
logmsg ("notice", "Server started at port $port");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   121
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   122
my $waitpid = 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   123
my $paddr;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   124
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   125
# wait for children to return, thus avoiding zombies
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   126
sub REAPER {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   127
  $waitpid = wait;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   128
  $SIG{CHLD} = \&REAPER; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   129
  logmsg ("notice", "reaped $waitpid", ($? ? " with exit $?" : ""));
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   130
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   131
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   132
# also all sub-processes should wait for their children
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   133
$SIG{CHLD} = \&REAPER;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   134
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   135
# start a new server for every incoming request
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   136
for ( ; $paddr = accept(Client, Server); close (Client)) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   137
  my ($port, $iaddr) = sockaddr_in($paddr);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   138
  my $name = lc gethostbyaddr($iaddr, AF_INET);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   139
  my $ipaddr = inet_ntoa($iaddr);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   140
  my $n = 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   141
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   142
# tell about the requesting client
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   143
  logmsg ("info", "Connection from $ipaddr ($name) at port $port");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   144
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   145
  spawn sub {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   146
    my ($head, $hlen, $pos, $pegel, $typ, $siz, $nch, $nrec, $dat, $i, $j, $n, $llen); 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   147
    my ($watchpegel, $shmpegel);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   148
    my ($rin, $rout, $in, $line, $data_requested, $oversample);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   149
    my (@channels);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   150
    
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   151
#   to use stdio on writing to Client
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   152
    Client->autoflush();
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   153
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   154
#   Open Device 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   155
    sysopen (DEV, "$dev", O_RDWR | O_NONBLOCK, 0666) or die("can't open $dev");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   156
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   157
#   Bitmask to check for input on stdin
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   158
    $rin = "";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   159
    vec($rin, fileno(Client), 1) = 1; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   160
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   161
#   check for authorized hosts
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   162
    my $access = 'allow';
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   163
    $access = 'allow' if $authhosts{$ipaddr};
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   164
    $line = "<remote_host host=\"$ipaddr\" access=\"$access\">\n";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   165
    $len = length $line;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   166
    $offset = 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   167
    while ($len) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   168
	$written = syswrite (DEV, $line, $len, $offset);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   169
	$len -= $written;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   170
	$offset += $written;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   171
    }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   172
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   173
    while ( 1 ) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   174
      $in = select ($rout=$rin, undef, undef, 0.0); # poll client
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   175
#     look for any Input from Client
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   176
      if ($in) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   177
#       exit on EOF
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   178
	$len = sysread (Client, $line, $blksize) or exit;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   179
	logmsg("info", "got $len bytes: \"$line\""); 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   180
	$offset = 0;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   181
#       copy request to device
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   182
	while ($len) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   183
	  $written = syswrite (DEV, $line, $len, $offset);
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   184
	  $len -= $written;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   185
	  $offset += $written;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   186
	}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   187
      }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   188
#     look for some output from device
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   189
      if ($len = sysread DEV, $stream, $blksize) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   190
	print Client $stream;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   191
      } else {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   192
	select undef, undef, undef, 0.1; # calm down if nothing on device
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   193
      }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   194
    }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   195
  }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   196
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   197
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   198
sub spawn {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   199
  my $coderef = shift;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   200
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   201
  unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   202
    confess "usage: spawn CODEREF";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   203
  }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   204
  my $pid; 
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   205
  if (!defined($pid = fork)) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   206
    logmsg ("notice", "fork failed: $!");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   207
    return;
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   208
  } elsif ($pid) {
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   209
    logmsg ("notice", "Request $pid");
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   210
    return; # Parent
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   211
  }
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   212
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   213
# do not use fdup as in the original example
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   214
# open (STDIN, "<&Client") or die "Can't dup client to stdin";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   215
# open (STDOUT, ">&Client") or die "Can't dup client to stdout";
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   216
# STDOUT->autoflush();
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   217
  exit &$coderef();
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   218
}
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   219
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   220
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   221
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   222
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   223
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   224
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   225
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   226
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   227
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   228
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   229
05c992bf5847 trunk, tags und branches
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   230