Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
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 scrutinizing the Monastery: (6)
As of 2014-07-12 13:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (240 votes), past polls