#!/usr/pkg/bin/perl -w
#
# AtomClient: a package to send posts to Atom-enabled services, like Blogger and LJ
# Copyright (C) 2005 Trevor Lalish-Menagh
# 
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# NOTE: Does NOT use WSSE since neither Blogger or LJ support WSSE anymore
#
# usage:
# use AtomClient qw(postentry);
# $result_msg = AtomClient::postentry("blog_url","username","password","title","content","method");
# 
# "method is either "basic" for Basic HTTP Auth, "digest" for Digest HTTP Auth, and 
# "google" for GoogleLogin Auth (Blogger)
# if no method is sent, basic will be tried first, then digest if basic fails, 
# then google if digest fails.

package AtomClient;

use strict;

# used for sending HTTP information
use IO::Socket::SSL;
use LWP::UserAgent;
use HTTP::Request::Common;
require HTTP::Headers;

# Used for encoding the password
use Digest::MD5 qw(md5_hex);
use MIME::Base64 qw(encode_base64);

# Display a failure message if we don't work.
# Send: diagnostics
sub failmessage {
	my $msg = "Content-type: text/html;charset=UTF-8\n\n";
	$msg .= "<html><head><title>POST Failed</title></head><body><h1>POST Failed</h1><code>";
	$msg .= $_[0];
	$msg .= "</code></body></html>";

	return ($msg);
} # end sub failmessage

# Display the response on success.
# Send: results
sub displayresult {
	my $msg = "Content-type: text/html\n\n";
	$msg .= $_[0];

	return ($msg);
} # end sub displayresult

# Retrive the authentication string for GoogleLogin requests
# Send user, pass
# NOTE: in GoogleLogin the user string is the user's email address
sub authGoogle {
	# get sent variables
	my $user = $_[0];
	my $pass = $_[1];

	my $client = IO::Socket::SSL->new("www.google.com:https");
	my $auth;

	if ($client) {
	    print $client "POST /accounts/ClientLogin HTTP/1.1\r\nContent-Type: application/x-www-form-urlencoded\r\nContent-Length: 82\r\n\r\nEmail=$user&Passwd=$pass&service=blogger&source=fshi-autublogger-1\r\n\r\n";
	    my @test = <$client>;
	    foreach (@test) {
	      if ($_ =~ m/^Auth=/) {
	        $auth = $_;
	        $auth =~ s/Auth=//;
   				}
	    }
	    close $client;
	} else {
	    warn "I encountered a problem: ",
	      IO::Socket::SSL::errstr();
	}

	return ($auth);
} # end sub googleAuth

# POST your entry to a service using Atom.
# First try Basic HTTP Auth, then try Digest HTTP Auth, then try GoogleLogin Auth
# Send url, user, pass, title, entry
sub postentry {
	# get sent variables
	my $url = $_[0];
	my $user = $_[1];
	my $pass = $_[2];
	my $title = $_[3];
	my $entry = $_[4];
	my $method = $_[5];
	my $debug = $_[6];

	# If anything but the method is not sent, return with error.
	if (!$url || !$user || !$pass || !$title || !$entry) {
		return AtomClient::failmessage("url: $url\nuser: $user\npass: ****\ntitle: $title\ncontent: $entry\n");
	} # end if (!$url || !$user || !$pass || !$title || !$entry)

	# Get the blog's URL for Atom URI
	my $blog_ua = LWP::UserAgent->new;
	my $blog_url = $url;

	# If the URL doesn't start with 'http://' add it
	if ($blog_url =~ /^[^http:\/\/]/) {
		$blog_url = "http://" . $blog_url;
	} # end if ($blog_url =~ /^[^http:\/\/]/)

	if ($debug) {
		print $blog_url."\n\n";
	}

	# get the blog URL
	my $blog_res = $blog_ua->request(GET $blog_url);

	if ($debug) {
		print $blog_res->as_string()."\n\n";
	}

	if ($blog_res->is_success) {
		# get the atom service.post address in the blog's HTML header
		my ($atom_url) = ( $blog_res->as_string() =~ /Link.*<(htt(p|ps):\/\/[^>].*?)>.*rel="service.post".*atom[\+]xml/ );

		if ($debug) {
			print $atom_url."\n\n";
		}

		# if we got a service.post link, continue.
		if ($atom_url) {
			# Try Basic HTTP Auth

			# get the time
			my ($sec, $min, $hour, $mday, $mon, $year) = gmtime();
			$mon++; $year += 1900;
			my $now = sprintf("%04s-%02s-%02sT%02s:%02s:%02sZ", $year, $mon, $mday, $hour, $min, $sec);

			# Prep the POST header
			my $request = POST $atom_url;
			$request->header('User-Agent' => 'http://trevreport.org/blogForm.shtml; jumex@trevreport.org');
			$request->header('Content_Type' => 'application/atom+xml');

			# If we are sending to Google (Blogger) send a google login auth
			if ($method =~ m/google/i) {
				my $authString = AtomClient::authGoogle($user, $pass);

				$request->header('Authorization' => "GoogleLogin auth=$authString");
			}

			# If we are not sending digest or a googlelogin, send a Basic HTTP Auth. header
			elsif ($method =~ m/[^digest]/i) {
				# encode the username and password
				my $userpass = MIME::Base64::encode_base64("$user:$pass");
				$request->header('Authorization' => "Basic $userpass");
			}

			# Escape the HTML tags in the title and entry (cotent)
			$title =~ s/&/&amp\;/g;
			$title =~ s/\</&lt\;/g;
			$title =~ s/\>/&gt\;/g;
			$entry =~ s/&/&amp\;/g;
			$entry =~ s/\</&lt\;/g;
			$entry =~ s/\>/&gt\;/g;

			# add the content of the post (in Atom-compliant XML)
			my $content = <<"TheEnd";
<?xml version="1.0" encoding="UTF-8"?>
<entry xmlns='http://www.w3.org/2005/Atom'>
<generator url="http://trevreport.org/blogForm.shtml">AtomClient</generator>
<title mode="escaped" type="text/html">$title</title>
<issued>$now</issued>
<content mode="escaped" type="text/html">$entry</content>
</entry>
TheEnd
;
			$request->content( $content );
			$request->header('Content-Length' => length($content));

			# Make the POST request
			my $ua = LWP::UserAgent->new;
			my $response = $ua->request($request);

			if ($debug) {
				print $request->as_string()."\n\n".$response->as_string()."\n\n";
			}

			# Display the result
			if ($response->is_success) {
				return AtomClient::displayresult($response->content);
			} else { # (!$response->is_success)
				# Try Digest HTML Auth
				my $response_str = $response->as_string();
				if ($response_str =~ m/\nWWW-Authenticate: Digest/i) {
					# Add the username
					my $digest = "username=\"$user\", ";

					# Return the realm
					my ($realm) = ( $response_str =~ /\nWWW-Authenticate: Digest.*realm=\"(.+?)\"/ );
					$digest .= "realm=\"$realm\", ";

					# Return the quality of protection used
					my ($qop) = ( $response_str =~ /\nWWW-Authenticate: Digest.*qop=\"(.+?)\"/ );
					$digest .= "qop=\"$qop\", ";

					# Return the algorithm used
					my ($algorithm) = ( $response_str =~ /\nWWW-Authenticate: Digest.*algorithm=(\w+)/ );
					$digest .= "algorithm=\"$algorithm\", ";

					# add the URI
					$digest .= "uri=\"$atom_url\", ";

					# get the nonce the server sent
					my ($nonce) = ( $response_str =~ /\nWWW-Authenticate: Digest.*nonce=\"(.+?)\"/ );
					$digest .= "nonce=\"$nonce\", ";

					# set the nc to 1
					$digest .= "nc=00000001, ";

				  # Create the cnonce
					my $cnonce = Digest::MD5::md5_hex(Digest::MD5::md5_hex(time() . {} . rand() . $$));
					$digest .= "cnonce=\"$cnonce\", ";

					# Create the Request Digest
					# KD(H(A1), nonce:nc:cnonce:qop:H(A2))
					# Where A1 = username:realm:password
					#				A2 = Method:uri
					#				H(data) = MD5(data)
					#		and	KD(secret, data) = H(secret:data)
					my $HA1 = Digest::MD5::md5_hex("$user:$realm:$pass");
					my $HA2 = Digest::MD5::md5_hex("POST:$atom_url");
					my $data = "$nonce:00000001:$cnonce:$qop:$HA2";
					my $request_digest = Digest::MD5::md5_hex("$HA1:$data");
					$digest .= "response=\"$request_digest\"";

					# Reset the Authorization header
					$request->header('Authorization' => "Digest $digest");

					# Make the POST request again
					$response = $ua->request($request);

					if ($debug) {
						print $request->as_string()."\n\n".$response->as_string()."\n\n";
					}

			    if ($response->is_success) {
						return AtomClient::displayresult($response->content);
					} else { # (!$response->is_success)
						return AtomClient::failmessage("$blog_url\n$blog_res->as_string()\n\n$atom_url\n$request->as_string()\n$response_str");
					} # end if ($response->is_success) ; else
				} else { # (!($response_str =~ m/\nWWW-Authenticate: Digest/i))
					return AtomClient::failmessage("$blog_url\n$blog_res->as_string()\n\n$atom_url\n$request->as_string()\n$response_str");
				} # end if ($response_str =~ m/\nWWW-Authenticate: Digest/i) ; else
			} # end if ($response->is_success) ; else
		} else { # (!$atom_url)
			return AtomClient::failmessage("$blog_url\n$blog_res->as_string()");
		} # end if ($atom_url) ; else
	} else { # (! $blog_res->is_success)
		return AtomClient::failmessage("$blog_url\n$blog_res->as_string()");
	} # end if ($blog_res->is_success) ; else

	if ($debug) {
		print "Impossible state.\n\n";
	}

	# we should never get here
	return AtomClient::failmessage ("$blog_url\n$blog_res->as_string()");
} # end sub postentry

# given the feed URL, list recent posts
# Basic HTTP Auth only
# Send: url, user, pass
sub listposts {
	# get sent variables
	my $url = $_[0];
	my $user = $_[1];
	my $pass = $_[2];

	# If anything but the method is not sent, return with error.
	if (!$url || !$user || !$pass) {
		return AtomClient::failmessage("url: $url\nuser: $user\npass: ****\n");
	} # end if (!$url || !$user || !$pass)
	
	# If the URL doesn't start with 'http://' add it
	if ($url =~ /^[^http:\/\/]/) {
		$url = "http://" . $url;
	} # end if ($url =~ /^[^http:\/\/]/)

	my $request = GET $url;
	$request->header('User-Agent' => 'http://trevreport.org/blogForm.shtml; jumex@trevreport.org');

	# encode the username and password
	my $userpass = MIME::Base64::encode_base64("$user:$pass");
	$request->header('Authorization' => "Basic $userpass");

	# Make the GET request
	my $ua = LWP::UserAgent->new;
	my $response = $ua->request($request);

	# Display the result
	if ($response->is_success) {
		return AtomClient::displayresult($response->content);
	} else { # (!$response->is_success)
		return AtomClient::failmessage($response->as_string());
	} # end if ($response->is_success) ; else
} # end sub listposts
