Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
気象庁の防災情報PuSH試行試行配信を受信するサブスクライバCGIの例 (cf. http://d.hatena.ne.jp/W53SA/20130109/1357750514 )
#!/usr/bin/env perl
#cf. http://d.hatena.ne.jp/W53SA/20130109/1357750514
use strict;
use LWP::Simple;
use XML::Atom::Feed;
use URI;
use File::Basename;
use Digest::HMAC_SHA1;
# this directory has permission to create file by this cgi
my $xmldir = '/path/to/data/directory/';
# hub.verify_token
my $verify_token = 'keykey';
# hub.secret
my $hmac_key = 'keykey';
my $atom_limit = 1024*1024;
# (un)subscribe
if($ENV{REQUEST_METHOD} eq 'GET'){
my $q = parse_query($ENV{QUERY_STRING});
if($q->{'hub.mode'} eq 'subscribe' || $q->{'hub.mode'} eq 'unsubscribe'){
my $challenge = $q->{'hub.challenge'};
my $topic = URI->new($q->{'hub.topic'});
if( ($q->{'hub.verify_token'} eq $verify_token)
&& ($topic->host =~ /xml\.kishou\.go\.jp$/) ){
print "Status: 200 OK\n";
print "Content-Type:text/plain\n\n";
print $challenge;
}else{
http_response(404,'unknown feed (un)subscribe reques');
}
}else{
http_response(403,'invalid access');
}
exit;
}
#receive PuSH
my $length = $ENV{CONTENT_LENGTH};
if($length > $atom_limit){
http_response(403,'too large data');
exit;
}
my $data;
if($length > 0){
read(STDIN,$data, $length);
if(defined $ENV{HTTP_X_HUB_SIGNATURE}){
my $hmac = Digest::HMAC_SHA1->new($hmac_key);
$hmac->add($data);
my $digest = 'sha1='.$hmac->hexdigest;
if($ENV{HTTP_X_HUB_SIGNATURE} ne $digest){
http_response(404,'Invalid X-Hub-Signature');
exit;
}
}
my $atom = eval{XML::Atom::Feed->new(\$data);};
process_atom($atom) if defined $atom;
}else{
http_response(200,'no data');
exit;
}
http_response(200,'OK');
exit;
sub http_response
{
my($code,$body) = @_;
my %msg = (
200 => 'OK',
403 => 'Forbidden',
404 => 'Not Found',
);
print << "_HTTP_";
Content-Type:text/plain
Status: $code $msg{$code}
$body
_HTTP_
}
sub parse_query
{
my $q = shift;
my @ps = split('&',$q);
my %query;
foreach my $p(@ps){
my($n,$v) = split('=',$p);
$v =~ tr/+/ /;
$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$query{$n} = $v;
}
\%query;
}
sub process_atom
{
my $atom = shift;
foreach my $it($atom->entries){
my $uri = URI->new($it->link->href);
next unless($uri->host =~ /xml\.kishou\.go\.jp$/);
getstore($uri,$xmldir.basename($uri->path()));
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment