気象庁の防災情報PuSH試行試行配信を受信するサブスクライバCGIの例 (cf. http://d.hatena.ne.jp/W53SA/20130109/1357750514 )

jma_push_subscriber_sample.pl

#!/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()));
	}
}