scratchpad
tachyon
<code>
# for thekestrel
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Parse::RecDescent;
my $grammar =<<'GRAMMAR';
IDENTIFIER : /\w+/ { [@item] }
LITERAL : /\d+/ { [@item] }
SEP : /;/ { [@item] }
parse : statement(s)
statement : call
| SEP
call : IDENTIFIER '(' LITERAL ')'
{ [ @item[0, 1, 3] ] }
GRAMMAR
my $parser = Parse::RecDescent->new($grammar);
my $text = <<'DATA';
func(4);foo(1);
DATA
my $lang = Language::C->new();
my $result = $parser->parse($text);
for my $item ( @$result ) {
print "Trying item : $item->[0]\n";
my $method = $item->[0];
$lang->$method(@$item);
}
package Language::C;
use vars '$AUTOLOAD';
sub new {bless {}, shift; }
sub AUTOLOAD { print "$AUTOLOAD Bugger!\n" . Data::Dumper::Dumper(\@_); }
sub SEP { return }
#sub DESTROY { return }
sub call { print "Doing a call\n", Data::Dumper::Dumper(\@_); }
</code>
<p>HTTP monitor code
<code>
# For smullis
package Monitor;
use strict;
use IO::Socket::INET;
use vars qw ( @ISA @EXPORT_OK $VERSION );
$VERSION = "0.03";
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
test_port_simple
test_port_detailed
);
# testing on port 25 requires sending (your) valid maildomain
my $MAILDOMAIN = 'hotmail.com';
sub test_port_simple {
my ( $server, $port, $timeout, $verbose ) = @_;
return "ERR - No server supplied" unless $server;
return "ERR - No port supplied" unless $port;
$timeout ||= 10;
print "Simple testing $server:$port\n" if $verbose;
my $sock = IO::Socket::INET->new( PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => $timeout,
ReuseAddr=>1,
#ReusePort=>1,
);
my $res = $sock ? 'OK' : "ERR - Could not connect socket on port $port";
$sock->close() if $sock;
undef $sock;
return $res;
}
sub test_port_detailed {
my ( $server, $port, $timeout, $verbose ) = @_;
return "ERR - No server supplied" unless $server;
return "ERR - No port supplied" unless $port;
$timeout ||= 10;
print "Detail testing $server:$port\n" if $verbose;
my $sock = IO::Socket::INET->new( PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => $timeout,
ReuseAddr=>1,
#ReusePort=>1,
);
unless ( $sock ) {
undef $sock;
return "ERR - Could not connect socket on port $port";
}
my $errors = '';
# OK so we have a socket but can we use it as expected
# depending on the protocol we apply different tests....
if ( $port == 21 ) {
my $server = <$sock>;
if ( $server ) {
print $sock "USER anonymous\015\012";
$server = <$sock>;
$errors .= "No USER response from FTP server\n" unless $server;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from FTP server\n";
}
}
elsif ( $port == 22 ) {
my $server = <$sock>;
if ( $server ) {
# the server expects a string back or logs errors
# echoing its ID string back shuts up the logs - stealth scan ;-)
print $sock $server;
}
else {
$errors .= "No handshake sent from SSH server\n";
}
}
elsif ( $port == 25 ) {
my $server = <$sock>;
if ( $server ) {
print $sock "HELO $MAILDOMAIN\015\012";
$server = <$sock>;
$errors .= "No HELO response from SMTP server\n" unless $server and $server =~ m/^250/;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from SMTP server\n"
}
}
elsif ( $port == 80 ) {
print $sock "GET / HTTP/1.0\015\012\015\012";
my $server = <$sock>;
$errors .= "Unexpected response from HTTP server: $server\n" unless $server and $server =~ m/^HTTP/;
}
elsif ( $port == 110 ) {
my $server = <$sock>;
if ( $server ) {
$errors .= "No OK sent by POP3 server\n" unless $server =~ m/OK/i;
print $sock "USER nobody\015\012";
$server = <$sock>;
print $sock "PASS wrong_password\015\012";
$server = <$sock>;
$errors .= "Failed to get expected ERR response\n" unless $server and $server =~ m/ERR/i;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from POP3 server\n";
}
}
elsif ( $port == 3128 ) {
print $sock "GET http://$server/ HTTP/1.0\015\012\015\012";
my $server = <$sock>;
$errors .= "Unexpected response from SQUID PROXY server\n" unless $server and $server =~ m/^HTTP/i;
}
else {
# we don't have a detail test but do have a socket so this is a NOP
}
$sock->close();
return $errors ? "ERR - $errors" : 'OK';
}
</code>
<code>
#!/usr/bin/perl -w
$|++;
use strict;
use Fcntl;
use POSIX qw(setsid);
my ($PROGRAM) = $0 =~ m!([^\\/:]+)$!;
my $LOCKFILE = "/var/lock/$PROGRAM";
my $LOG = "/var/log/$PROGRAM.error.log";
# use a lockfile to prevent spawning duplicate processes
unless ( sysopen(my $fh, $LOCKFILE, O_CREAT | O_EXCL | O_RDWR, 0600) ) {
# the lockfile already exists
print "Lockfile $LOCKFILE aready exists.\nChecking for running $PROGRAM process...";
my @ps = grep{ m/\Q$PROGRAM\E/ } `ps -C $PROGRAM`;
# we expect 1 copy (us) running
# print "@ps\n";
die "\nThere is already a copy of $PROGRAM running!\n" if @ps > 1;
print "None!\n";
}
# now demonize it
defined(my $pid = fork) or die "Can't fork: $!";
exit 0 if $pid;
chdir '/' or die "Can't chdir to /: $!";
umask 0;
setsid() or die "Can't start a new session: $!";
$SIG{INT} = $SIG{TERM} = sub {
unlink $LOCKFILE or warn "Could not unlink $LOCKFILE for $PROGRAM\n";
exit;
};
$SIG{HUP} = sub {
warn "Caught HUP " . time() . "\n";
# do reset stuff if required
};
print "Started $0 daemon OK\n\n";
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
#open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
open STDERR, ">>$LOG" or die "Can't write to $LOG: $!";
# this is the main loop that runs forever, once every 30 seconds
while (1) {
eval{ ... }; # use eval to exec any code so if it chokes the daemon survives
warn "$@\n" if $@;
sleep 30;
}</code>