#!/usr/bin/perl
use strict vars;
use Jcode;
use LWP::UserAgent;
my $req;
if ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
read( STDIN, $req, $ENV{'CONTENT_LENGTH'} );
} else {
FatalResponse( 503 );
}
=rem
* Seesaaでの例
weblogUpdates.ping
testblog-blog
http://memo.hirosiki.jp/
* MovableTypeでの例
weblogUpdates.ping
testblog-blog
http://memo.hirosiki.jp/
=cut
my $url =
( $req =~ m!(?:)?(http://.*?)(?:)?! )[0]
;
Response();
while ( ) {
s/^\s+//;
s/\s+$//;
next if ( /^$/ || /^#/ );
my $name = ( split( /\t/, $_ ) )[0];
my $rest = $_;
$rest =~ s/^$name\t//;
my @args = split( /\t/, $rest );
my $cmd = shift @args;
next
if ( $url !~ m|^http://$name| );
if ( $cmd =~ s/^!// ) {
system( $cmd );
next;
}
my $cmdroutine = "__cmd_$cmd";
&$cmdroutine( $url, @args );
}
exit;
sub __cmd_mailto {
my @args = @_;
my $site = shift @args;
system( "echo '$site' | mail -s '[ping received] $site' $args[0]" );
}
sub __cmd_rssaddto {
my @args = @_;
my $site = shift @args;
my $cnt = GetRSS( $site )
or do {
Warn( "Could not get $site content" );
exit;
};
print STDERR substr( $cnt, 0, 20 ) . "\n";
}
sub GetRSS {
my $site = shift @_;
my $rssUrl = GetRSSURL( $site )
or return; # エラー
my $cnt = GetEucURL( $rssUrl )
or return; # エラー
return( $cnt );
}
sub GetRSSURL {
my $site = shift @_;
my $cnt = GetEucURL( $site )
or return; # エラー
my $rssUrl =
( $cnt =~ m|]{0,}>|ig )[0]
;
return # エラー
if ( $rssUrl !~ /^http:/ );
return( $rssUrl );
}
sub Warn {
print STDERR shift @_;
}
sub GetEucURL {
my $url = shift @_;
my $refConf = shift @_;
my $timeout = 10;
my $max_size = 128;
if ( $refConf ) {
if ( $$refConf{timeout} ) {
$timeout = $$refConf{timeout};
}
if ( $$refConf{max_size} ) {
$max_size = $$refConf{max_size};
}
}
my $ua = LWP::UserAgent->new(
agent => 'Mozilla/4.0 (compatible; MSIE 6.0)',
timeout => $timeout,
max_size => $max_size * 1024,
);
my $response;
$response = $ua->get( $url )
or return; # エラー
return # エラー
if ( !$response->is_success );
my $eucContent;
$eucContent = jcode( $response->content )->h2z->euc;
return( $eucContent );
}
sub FatalResponse {
my $r = shift @_;
print "Response: $r\n\n";
exit;
}
sub Response {
my %params = (
flerror => 0,
message => 'Thanks for the ping',
@_,
);
print <<"_EOF_";
Content-Type: text/xml
flerror
$params{'flerror'}
message
$params{'message'}
_EOF_
}
__DATA__
#memo.hirosiki.jp mailto hoge@hoge.jp
#memo.hirosiki.jp !/var/net/www/hirosiki.jp/update.ping/something.to.exec