[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
Re: [MacPerl] Unix daemons in Perl on MacOS?
on 01/25/2000 5:45 PM, Brian McNett at webmaster@mycoinfo.com wrote:
> I've no code yet, but I'm hoping to get some sort of discussion going
> here to give me ideas of where to go with this.
I apologize for being late jumping into this discussion - but isn't the
definition of a 'daemon' a server waiting around listening to sockets?
Try this:
#!/usr/local/bin/perl -wT
# OverCR Collector V1.50.00 08/28/1999
#
# This is GPL software, see COPYING for liscense
# Copyright 1998, 1999
#
# People who have contributed code
#
# Eric Molitor (eric@molitor.org)
# Bill Jones (bill@fccj.org) AKA -Sneex-
# Joerg Strangfeld <joerg.strangfeld@javelinx.com>
#
# 1.49.50 - Major Rewrite by -Sneex-
# Based upon v1.49.07...
# Probably contains new bugs...
# 1.47.07 Revision History -
# 1.49.07 - Fixed Glob Failure caused by forking
# 1.49.06 - Better Handling of Config File Location
# 1.49.05 - Daemonize with code from Joerg Strangfeld
# 1.49.04 - Signal HUP is now processed to reconfigure
# 1.49.03 - Spelling and logging format fixes
# 1.49.02 - Implemented allowed services in config file
# 1.49.02 - Minor Commenting and formatting changes
# 1.49.01 - Require 5.004
# 1.49.01 - Added Config File Support
# 1.00.00 - Initial Release
# 0.99.53 - Rewrote Uptime
# 0.99.52 - Improved Uptime Help Information
# 0.99.52 - Added postel function
# 0.99.51 - Added help function
# 0.99.51 - Added architecture to version
# 0.99.51 - Fixed netstat on Solaris/SunOS
# 0.99.50 - Removed/Changed reserved words
# 0.99.50 - Removed D.O.S. attack (Empty Commands now handled correctly)
# 0.99.50 - Fixed signal handling of SigAlarm
# 0.99.50 - Check return values on ALL IO operations
# 0.99.50 - Fixed orphaned die during socket creation
# 0.99.50 - Cleaned up variables in ocr_uptime
# 0.99.50 - Uptime now has a precision of 2
# 0.99.50 - Fixed Netstats and Process whining about uninitialized
variables
# 1.47.07 To Do List:
# - Improved architecture detection and handling
# <CURRENT CODE BASE: 1.50.00>
# End of comments...
### WARNING: Do not change ANYTHING! Not unless you really really want to
spend time debugging...
### However: If you really think you know what you are doing -- then
change whatever you want :]
require 5.004;
use strict;
use diagnostics;
use Socket;
use POSIX;
use IO;
my $maxTO = 5; # Set to prevent hung clients...
unless (@ARGV && (@ARGV > 2)) {
print <<_Usage;
Usage: $0 timeout port_number path_to_files [Enter]
Where -
'timeout' is the amount of time a client
can be idle before being disconnected...
'port_number' is the port upon which to listen
for requests. You must be ROOT to connect on
a privledged port less than 1023 (inclusive...)
'path_to_files' is the path to use for finding
and/or storing needed files, etc...
Running OverCR_Server...
_Usage
}
# Number of Seconds before disconnecting - Not used in this release -Sneex-
:]
my $timeout = pop(@ARGV) || 2;
unless ($timeout > 0 && $timeout < $maxTO) {
print "Value $timeout: Not numeric or not between 1 thru $maxTO. Using
2";
}
# Port number to run on...
my $server_port = pop(@ARGV) || 2000;
die "Privledged Port $server_port Requested: Access Denied.\n"
unless (($server_port > 1023) || ($> > 0));
# Path to log file, pid file, and others...
my $path = pop(@ARGV) || '';
unless (-d $path) {
print "Directory $path specified does not exist. Using ", `pwd`;
} else {
# Create the 'logfile' @ specified location
my $log_file = $path . $0 . ".log";
# Open it Write Only (O_WRONLY), in Append Mode (O_APPEND),
# if it already exists; otherwise Create the file (O_CREAT)
# Set the file permission bits to 0600 ( -rw------- )
my $fh = new IO::File $log_file, O_WRONLY|O_APPEND|O_CREAT, 0600;
if (defined $fh) {
print $fh $0 . " started by " . $> . " for Port " .
$server_port . " on Date: " . (localtime) . "\n";
undef $fh;
} else { die "Oops! Betcha that hurt: $!"; }
# Flush all I/O buffers...
autoflush STDOUT 1;
# Set the file path globally -
$path = $log_file;
}
# List of allowed services; one per line...
my @services = qw{
diskspace
uptime
load
postel
process
netstat
help
};
# List of IP's (or hosts/domains pairs) to allow. The first is a simple
# hostname only, the second a Domain only, ext an IP Addr only...
my @ip_allow = qw{
dss
InSecurity.Org
127.0.0.1
};
# Make the socket...
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
# So we can restart our server quickly
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
# Build up my socket address...
my $my_addr = sockaddr_in($server_port, INADDR_ANY);
bind(SERVER, $my_addr)
or die "Couldn't bind to addr $my_addr on port $server_port : $!\n";
# Establish a queue for incoming connections...
listen(SERVER, SOMAXCONN)
or die "Couldn't listen on port $server_port : $!\n";
# Accept and process connections...
while (accept(CLIENT, SERVER)) {
$/ = '';
my $data_read = '';
my $maxlen = 1500; # MTA Limit, no fragment...
my $flags = 0;
my $data_to_send = '';
defined (recv(CLIENT, $data_read, $maxlen, $flags))
or die "Can't read: $! $@";
$data_to_send = pack("u*",$data_read);
#$data_to_send = $data_read;
print "IN: $data_read OUT: $data_to_send\n";
send (CLIENT, $data_to_send, $flags);
defined (recv(CLIENT, $data_read, $maxlen, $flags))
or die "Can't read: $! $@";
$data_to_send = unpack("u*",$data_read);
#$data_to_send = $data_read;
print "IN: $data_read OUT: $data_to_send\n";
send (CLIENT, $data_to_send, $flags);
# End of Server Code Portion...
}
close(SERVER);
exit;
Note: The OverCR project is at http://www.overcr.org/
____________________________________________________________________
Bill Jones * Systems Programmer * http://www.fccj.org/cgi/mail?sneex
('> Running -
//\ Perl, Apache, MySQL, PHP3,
v_/_ Ultra 10, LinuxPPC, BeOS...
# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org