Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
Don't ask to ask, just ask
 
PerlMonks  

tachyon's scratchpad

by tachyon (Chancellor)
on Jun 01, 2004 at 18:32 UTC ( #358364=scratchpad: print w/ replies, xml ) Need Help??

# 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(\@_); }

HTTP monitor 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 $se +rver; 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 s +can ;-) 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 $s +erver 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" u +nless $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" unl +ess $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'; }
#!/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 $PR +OGRAM 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 dae +mon survives warn "$@\n" if $@; sleep 30; }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (12)
As of 2014-04-18 13:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (468 votes), past polls