#!/usr/bin/perl -w
# Version 1.1 BETA
# Author: miles@tenhand.com
# Home/Docs/Licensing http://www.tenhand.com/blosxthis

# USAGE: |./blosxthis.pl password  /path/to/blogdir [/path/to/countfile] 
# If there are two arguments, a plaintext password is used. 
# if there are three, we will verify that the user's password is 
# in the chain of hashes starting with the password and ending with 
# the number stored in the countfile.

# What the program does:
# Read STDIN/mail message  looking for one of the following commands:
# "blog-this: Password" (add a new blog entry) 
# "kill-this: Password blog.txt (delete blog.txt entry)
# "edit-this: Password blog.txt (replace blog.txt entry with this email)
 
# This program goes to silly lengths to exit in a way that 
# doesn't expose system information and is always right for the 
# mailer software. If you think this is a bug, change the BAIL 
# entries to something more verbose

# This paticular version includes a horrible hack to support saving pictures
# via email.  It needs to be cleaned but should work ok. 
# Pictures will be dropped in the blog folder, 
# using the lowercase version of the attachment's name
# This hack requires the MIME::Base64  module from CPAN:
# sudo perl -MCPAN -e 'install MIME::Base64'
# At the moment it only handles base64 encoded jpeg mime attachments, but
# that's probably 90% of what people are likely to mail
# use picture-this: password  to upload the picture for manual linking. 
# blog-this: password will save all pictures and append them as links to
#  the end of your blog entry

use Digest::MD5   qw ( md5 md5_hex);
use MIME::Base64 ;
 
# This is the webserver's path to the base blosxom directory
$webpath="http://www.example.com/blosxom ";

my ($isfound, $blog, $pix , $boundary, $type, $top, $usemime);
$top=0; $usemime=0; $isfound=0;

($secret,$path,$countfile) = @ARGV;
if ( $countfile) { # find out our current count
    open (C,"$countfile") or &BAIL;
    <C>=~/^(\d+)/;    
    $top+=$1;
    close C;
}
# assuming that the blog is in a subdirectory not the base blosxome
$path=~ /.*\/(\S+)$\/*/; # grab the last directory
$webpath= $webpath . $1 ;

my $x=0;
while (<STDIN>) {
   if (/^Content-Type:\s+multipart/) { $usemime=1; next; }
    if (/^(\S+)\-*this: (\S+)(.*)/i ) {
	$ba=$1; $pass=$2; $rest=$3; 
	last;
    }
    ($x > 30) ? &BAIL : $x++;
}

 ($pass) ? &checkpw() : &BAIL;

for ($ba) {
   if ( /blog/i || /post/i ) {
	$stat= &postblog;
	if  ($stat >0) {
		if  ($usemime)  {
	  	&writepix(1); #save any pix & append as links.
		}
	&GOOD;
	}
   &TEMP; 	
   }
   if  ( /picture/i || /pix/i )   {
       if ($usemime >0) { &writepix() ; &GOOD; }
   } else { # we are changing an existing file
	#files with only safe characters in filename
	unless ($rest =~/^\s+([a-zA-Z0-9\-\_]+)\s*/) { &BAIL} ; 
	$blog= $path . $1 . "\.txt";
	unless ( -f $blog ) { &BAIL; }
    }
   if  ( /del/i || /kill/i )   {
	unlink ($blog) ? &GOOD :  &BAIL ;
    }
   if  ( /edit/i || /update/i || /mod/i )    {
	@mtime= stat($blog);
	$mt=$mtime[9];
	&postblog($blog) and utime($mt,$mt,$blog) ; #move mtime back 
	&GOOD; # posting is good enough
    }
   &BAIL; # no command found
}

sub checkpw() {
    for ($x=1; $x <= $top; $x++) { 
	$secret=md5_hex($secret);
	if ( $secret =~ /^$pass/) { 
	    open (C,">  $countfile ") or &BAIL;
	    print C $x-- . "\n";
	    close C;
	    return (1);
	}
    }
 unless ($countfile) { if  ( $pass eq $secret ) { return(1); } }
 &BAIL ;
}

sub postblog() {
    ($blog) = @_; my $x=0;
    unless ( $blog ) { $blog = "$path/" . time() . "\.txt"; }
    open ( BLOG, ">$blog") or &TEMP;
    while (<STDIN>) {
	if ( ! /\S/) { next; } #  Use HTML if you need blank lines
	if ( /^--/ ) { $isfound=1; last; } # hit a new mime boundary
	# s/\<script /\<\&gt\>script /; # kill off cross site scripting?
	($x<300) ? $x++ : &BAIL; # this is a blog, not moby dick.
	print BLOG $_; 
    }
    close BLOG;
    ( -z $blog)   ? unlink "$blog" :  chmod 0644, $blog ;  
    return 1;
}

#### The exit codes must match your mail server
sub BAIL { # clearly bounce mail. 
    exit (100); }#qmail is 100, sendmail is 1,
sub TEMP { &BAIL; } #usually better to bail
#    exit (111);} # qmail is 111, sendmail is 75
sub GOOD {  exit (0); } # mail accepted


sub FindPix { # Very lame function for base64 encoded jpegs
# should be smart enough to understand gif, png &etc, but it isn't.
    my ( $mfile, $mtype,$mcode);
    while (<STDIN>) { 
	if (/^\s*$/) { last; } # stop at 1st blank line
	if (/^Content-Transfer-Encoding: (\S+)/) { $mcode=$1; next; };
	if (/^Content-Type:\s* image\/(\S+)/)  { $mtype=$1;  };
	if (/name\=\"(\S+)\"/) { $mfile= $1; }; 
    }
    unless ( ($mcode) && ($mtype)) { return (-1); }
    unless ( $mcode =~ /base64/ ) { return (-1);  } #todo: add codes
    if  ( ( $mtype =~ /jpeg/ )  )  {  # todo add gif
	$pix= $mfile; $type= "jpg";
	return 1; 
    }
    return -1;
}

sub cleanup {
    $pix =~ /(\S+)\.\S+\s*$/; #yes this does blog foo.bar.baz.jpg
    $pix = $1;
    $pix =~ s/[^A-Za-z0-9\_\-\=]/-/g ; #safe chars
    $pix =~ tr/A-Z/a-z/; # lowercase
    $pix = "$pix.$type" ;
}

sub writepix {
($isblog)=@_; # do we write blog links as well as saving pictures?
if ($isblog) {
open (BLOG, ">>$blog") or print "damn, can't modify blog";
} 
     while (<STDIN>) {
	# isfound = kludge = global used when we found boundary in postblog.
	if ((/^--/) || ($isfound) ) { # probably some mime boundary 
		 $isfound=0;		
	    $foo = FindPix(); # see if it is a base64 mime picture 
	    if ( $foo < 1 ) { next;  } 
	    cleanup ();
		if ($isblog) {		
			print BLOG "<br><A HREF=\"$webpath/$pix\">Link to picture $pix</a>\n";
		}
    		$pix = "$path/$pix" ;
	    open ( OUT , "> $pix") or die "no pix" ; 
	    while (<STDIN>) { # decode message
		if  (/^\s*$/) {  # blank = EOM
		    close (OUT);
		    chmod 0644, $pix;
		    last; 
		}
		print OUT decode_base64($_); 
	    } 
	}
    }  
}