examples/msr/msrserv.pl
author Florian Pose <fp@igh-essen.com>
Mon, 12 Mar 2007 13:59:06 +0000
changeset 651 8c11399cc911
parent 246 0bf7c769de06
permissions -rwxr-xr-x
Fixed skipped datagrams when not in FSM idle phase.
224
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     1
#!/usr/bin/perl -w
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     2
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     3
#------------------------------------------------------------------------------
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     4
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     5
#  Copyright (C) 2006  Ingenieurgemeinschaft IgH
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     6
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     7
#  This file is part of the IgH EtherCAT Master.
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     8
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
     9
#  The IgH EtherCAT Master is free software; you can redistribute it
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    10
#  and/or modify it under the terms of the GNU General Public License
246
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    11
#  as published by the Free Software Foundation; either version 2 of the
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    12
#  License, or (at your option) any later version.
224
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    13
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    14
#  The IgH EtherCAT Master is distributed in the hope that it will be
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    15
#  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    16
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    17
#  GNU General Public License for more details.
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    18
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    19
#  You should have received a copy of the GNU General Public License
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    20
#  along with the IgH EtherCAT Master; if not, write to the Free Software
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    21
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    22
#
246
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    23
#  The right to use EtherCAT Technology is granted and comes free of
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    24
#  charge under condition of compatibility of product made by
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    25
#  Licensee. People intending to distribute/sell products based on the
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    26
#  code, have to sign an agreement to guarantee that products using
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    27
#  software based on IgH EtherCAT master stay compatible with the actual
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    28
#  EtherCAT specification (which are released themselves as an open
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    29
#  standard) as the (only) precondition to have the right to use EtherCAT
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    30
#  Technology, IP and trade marks.
0bf7c769de06 Changed license headers and added EtherCAT license notice.
Florian Pose <fp@igh-essen.com>
parents: 224
diff changeset
    31
#
224
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    32
#------------------------------------------------------------------------------
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    33
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    34
#  Multithreaded Server
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    35
#  according to the example from "Programming Perl"
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    36
#  this code is improved according to the example from
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    37
#  perldoc perlipc, so now safely being usable under Perl 5.8
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    38
#  (see note (*))
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    39
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    40
#  works with read/write on a device-file
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    41
#
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    42
#------------------------------------------------------------------------------
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    43
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    44
require 5.002;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    45
use strict;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    46
BEGIN { $ENV{PATH} = '/opt/msr/bin:/usr/bin:/bin' }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    47
use Socket;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    48
use Carp;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    49
use FileHandle;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    50
use Getopt::Std;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    51
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    52
use Sys::Syslog qw(:DEFAULT setlogsock);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    53
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    54
use vars qw (
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    55
	     $self $pid $dolog $port $dev %opts $selfbase
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    56
	     $len $offset $stream $written $read $log $blksize
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    57
	     $instdir
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    58
	     $authfile %authhosts
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    59
	     );
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    60
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    61
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    62
# Do logging to local syslogd by unix-domain socket instead of inetd
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    63
setlogsock("unix");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    64
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    65
# Prototypes and some little Tools
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    66
sub spawn;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    67
sub logmsg {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    68
  my ($level, $debug, @text) = @_;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    69
  syslog("daemon|$level", @text) if $debug > $dolog;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    70
#  print STDERR "daemon|$level", @text, "\n" if $dolog;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    71
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    72
sub out {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    73
  my $waitpid = wait;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    74
  logmsg("notice", 2, "$waitpid exited");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    75
  unlink "$selfbase.pid";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    76
  exit 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    77
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    78
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    79
sub help {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    80
  print "\n  usage: $0 [-l og] [-h elp] [-p port] [-d device]\n";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    81
  exit;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    82
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    83
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    84
# Process Options
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    85
%opts = (
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    86
	 "l" => 1,
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    87
	 "h" => 0,
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    88
	 "p" => 2345,
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    89
	 "d" => "/dev/msr"
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    90
	 );
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    91
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    92
getopts("lhp:d:", \%opts);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    93
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    94
help if $opts{"h"};
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    95
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    96
( $self =  $0 ) =~ s+.*/++ ;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    97
( $selfbase = $self ) =~ s/\..*//;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    98
$log = "$selfbase.log";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
    99
$dolog = $opts{"l"};
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   100
$port = $opts{"p"};
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   101
$dev = $opts{"d"};
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   102
$blksize = 1024; # try to write as much bytes
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   103
$instdir = "/opt/msr";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   104
$authfile = "$instdir/etc/hosts.auth";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   105
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   106
# Start logging
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   107
openlog($self, 'pid');
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   108
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   109
# Flush Output, dont buffer
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   110
$| = 1;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   111
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   112
# first fork and run in background
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   113
if ($pid = fork) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   114
#  open LOG, ">$log" if $dolog;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   115
#  close LOG;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   116
  logmsg("notice", 2, "forked process: $pid\n");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   117
  exit 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   118
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   119
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   120
# Server tells about startup success
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   121
open (PID, ">/$instdir/var/run/$selfbase.pid");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   122
print PID "$$\n";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   123
close PID;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   124
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   125
# Cleanup on exit (due to kill -TERM signal)
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   126
$SIG{TERM} = \&out;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   127
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   128
# We use streams
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   129
my $proto = getprotobyname('tcp');
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   130
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   131
# Open Server socket
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   132
socket(Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   133
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   134
  or die "setsocketopt: $!";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   135
bind (Server, sockaddr_in($port, INADDR_ANY))
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   136
  or die "bind: $!";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   137
listen (Server, SOMAXCONN)
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   138
  or die "listen: $!";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   139
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   140
%authhosts = ();
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   141
# get authorized hosts
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   142
open (AUTH, $authfile)
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   143
  or logmsg ("notice", 2, "Could not read allowed hosts file: $authfile");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   144
while (<AUTH>) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   145
    chomp;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   146
    my $host = lc $_;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   147
     if ($host =~ /^[\d\w]/) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   148
	 $authhosts{$_} = 1;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   149
	 logmsg ("notice", 2, "Authorized host: >$host<");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   150
     }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   151
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   152
close (AUTH);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   153
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   154
# tell about open server socket
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   155
logmsg ("notice", 2, "Server started at port $port");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   156
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   157
my $waitedpid = 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   158
my $paddr;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   159
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   160
# wait for children to return, thus avoiding zombies
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   161
# improvement (*)
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   162
use POSIX ":sys_wait_h";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   163
sub REAPER {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   164
  my $child;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   165
  while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   166
    logmsg ("notice", 2, "reaped $waitedpid", ($? ? " with exit $?" : ""));
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   167
  }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   168
  $SIG{CHLD} = \&REAPER;  # loathe sysV
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   169
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   170
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   171
# also all sub-processes should wait for their children
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   172
$SIG{CHLD} = \&REAPER;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   173
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   174
# start a new server for every incoming request
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   175
# improvement (*) -- loop forever
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   176
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   177
while ( 1 ) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   178
  for ( $waitedpid = 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   179
	($paddr = accept(Client,Server)) || $waitedpid;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   180
	$waitedpid = 0, close Client ) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   181
    next if $waitedpid and not $paddr;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   182
    my ($port, $iaddr) = sockaddr_in($paddr);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   183
    my $name = lc gethostbyaddr($iaddr, AF_INET);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   184
    my $ipaddr = inet_ntoa($iaddr);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   185
    my $n = 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   186
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   187
# tell about the requesting client
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   188
    logmsg ("info", 2, "Connection from >$ipaddr< ($name) at port $port");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   189
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   190
    spawn sub {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   191
      my ($head, $hlen, $pos, $pegel, $typ, $siz, $nch, $nrec, $dat, $i, $j, $n, $llen); 
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   192
      my ($watchpegel, $shmpegel);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   193
      my ($rin, $rout, $in, $line, $data_requested, $oversample);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   194
      my (@channels);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   195
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   196
#   to use stdio on writing to Client
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   197
      Client->autoflush();
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   198
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   199
#   Open Device
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   200
      sysopen (DEV, "$dev", O_RDWR | O_NONBLOCK, 0666) or die("can't open $dev");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   201
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   202
#   Bitmask to check for input on stdin
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   203
      $rin = "";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   204
      vec($rin, fileno(Client), 1) = 1;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   205
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   206
#   check for authorized hosts
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   207
      my $access = 'deny';
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   208
      $access = 'allow' if $authhosts{$ipaddr};
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   209
      $line = "<remote_host host=\"$ipaddr\" access=\"$access\">\n";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   210
      logmsg ("info", 2, $line);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   211
      $len = length $line;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   212
      $offset = 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   213
      while ($len) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   214
	$written = syswrite (DEV, $line, $len, $offset);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   215
	$len -= $written;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   216
	$offset += $written;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   217
      }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   218
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   219
      while ( 1 ) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   220
	$in = select ($rout=$rin, undef, undef, 0.0); # poll client
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   221
#     look for any Input from Client
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   222
	if ($in) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   223
#       exit on EOF
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   224
	  $len = sysread (Client, $line, $blksize) or exit;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   225
	  logmsg("info", 0, "got $len bytes: \"$line\"");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   226
	  $offset = 0;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   227
#       copy request to device
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   228
	  while ($len) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   229
	    $written = syswrite (DEV, $line, $len, $offset);
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   230
	    $len -= $written;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   231
	    $offset += $written;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   232
	  }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   233
	}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   234
#     look for some output from device
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   235
	if ($len = sysread DEV, $stream, $blksize) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   236
	  print Client $stream;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   237
	} else {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   238
	  select undef, undef, undef, 0.1; # calm down if nothing on device
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   239
	}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   240
      }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   241
    };
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   242
    logmsg("info", 2, "spawned\n");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   243
  }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   244
  logmsg("info", 2, "server loop\n");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   245
}
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   246
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   247
sub spawn {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   248
  my $coderef = shift;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   249
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   250
  unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   251
    confess "usage: spawn CODEREF";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   252
  }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   253
  my $pid;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   254
  if (!defined($pid = fork)) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   255
    logmsg ("notice", 2, "fork failed: $!");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   256
    return;
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   257
  } elsif ($pid) {
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   258
    logmsg ("notice", 2, "Request $pid");
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   259
    return; # Parent
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   260
  }
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   261
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   262
# do not use fdup as in the original example
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   263
# open (STDIN, "<&Client") or die "Can't dup client to stdin";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   264
# open (STDOUT, ">&Client") or die "Can't dup client to stdout";
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   265
# STDOUT->autoflush();
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   266
  exit &$coderef();
4828e5e419bf Renamed rt example to msr.
Florian Pose <fp@igh-essen.com>
parents:
diff changeset
   267
}