#!/usr/bin/perl

use LWP::UserAgent;
use CGI;
use POSIX qw(strftime);
use strict;
use Data::Dumper;

################
# Nokia Image Upload Server (for the 3650/7650 cellphones)
# Copyright (C) 2003 Steve Pomeroy <steve@staticfree.info>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
#
################
# thanks to:
# http://the.taoofmac.com/space/blog/2003-06-15
# for a good code example to work off of
############
# $Id: nokia_image_upload.pl,v 1.4 2005/12/01 09:33:45 steve Exp $
####
# $Log: nokia_image_upload.pl,v $
# Revision 1.4  2005/12/01 09:33:45  steve
# attempts to deal with overwrite conflicts
#
# Revision 1.3  2004/01/29 20:05:46  steve
# added more documentation and the crypt script
#
# Revision 1.2  2003/12/15 06:31:26  steve
# added blosxom support
#
# Revision 1.1  2003/12/01 08:09:34  steve
# Initial revision
#
#
############

######################################################################
# 
#  To use this, make sure you go through the config area and set everything up.
#  At present, it has my configuration loaded into it as an example. Don't use this.
#  
#  To create the password file, copy out this perl 'one-liner', (remove comments):

# perl -e 'print "\nEnter your password:\n"; $p = g();
# $c = crypt($p, join "", (".", "/", 0..9, "A".."Z", "a".."z")
# [rand 64, rand 64]), "\n";
# print "re-enter your password: \n"; $p = g();
# if( crypt( $p, $c) eq $c ){ print "Good. Crypted password: $c\n"; }
# else { print "passwords did not match\n" };
# sub g{ system "stty -echo"; ($p) = <STDIN> =~ /^(.+)$/m; system "stty echo";
# return $p; }'

# paste it into bash or zsh and give it a go. The password file is simply:
#
# USERNAME CRYPTED_PASSWORD
#
# one line per user with whitespace separating the username and password.
#
######################################################################
my $query = new CGI;

######################################################################
######################## begin config area ###########################
######################################################################

######################### basic configuration ######################## 
my $debug = 1;

# set this to be the URL of the image uploader, as seen by the outside world. 
# You'll probably want to mess with Apache so that it's a cleaner URL
my $url = "http://staticfree.info/nokiaupload";

# where to store the files. Make sure that the web server has permission to write to 
# this
my $localdir = "/bfg/image/steve/photos/cellcam/";

# make sure this can't be accessed from the 'web, but make the web server be able 
# to read from it. 
my $passwd_file = "/home/httpd/xavier/upload_passwd";

# NOTE:
# if you only want to use this for uploading images, make sure to disable
# the various things below
#
####################### Apache::Gallery ##############################
# Apache::Gallery ping
# this will be queried in order to force Apache::Gallery to generate the
# appropriate image thumbnails. Escape all variables as it will be re-interpolated later.
# set it to "" to disable
my $gallery_ping = "\$public_url\$filedir/\$filename?width=320";

# this is the URL of wherever your photo gallery is. %URL% will be replaced 
# by it in the template strings
my $public_url = "http://photos.staticfree.info/cellcam/";

######################## blosxom integration ######################### 

# set this to 0 to disable permenantly
my $use_blosxom = 1; # = 0;

# template strings. A seperate post will be for each image in a single upload
my $blosxom_post = qq(<a href="\$public_url\$filedir/\$filename"><img border="0" src="\$public_url\$filedir/.cache/320x240-\$filename" alt="\$filename" /></a>\n);
my $blosxom_head = qq(Cellcam photos - \$filedir\n<p>New photos in <a href="\$public_url\$filedir/">\$filedir/</a>:</p><p> \n);
my $blosxom_placeholder = "<!-- foot -->\n";
my $blosxom_seemore = "</p><!-- more --><p>\n";
my $blosxom_foot = "\n</p>";

# strftime-parsed
my $blosxom_filename = "%Y-%m-%d_%H:%M.txt";
my $filename = "";
my $filedir = "";

# if you want to use the blosxom posting, set this line to the directory
# you want this to automatically generate posts to. A new .txt file will be
# created each time you upload a set of images with the contents of
# $blosxom_post for each entry
my $blosxom_dir = "/home/steve/blosxom/meat/cellcam/";
# 
# only by appending this to the URL (the $url above) will it will it actually post to 
# blosxom:
my $blosxom_path = "/blosxom";

######################################################################
######################### end config area ############################
######################################################################

if( $debug ){
    print STDERR "calling upload.pl\n";
    print STDERR "with params:".join(",", $query->param())."\n";
    print STDERR "with url params:".join(",", $query->url_param())."\n";
}
my $uri = $ENV{'PATH_INFO'};
my $origuri = $uri;

if( $use_blosxom ){
    $use_blosxom = $uri =~ /^$blosxom_path/;

    if( $use_blosxom ){
	$uri =~ s/$blosxom_path//;
	$url .= $blosxom_path;
    }
}


if( $debug ){
    print STDERR "request uri: $uri\n";
}

if( $uri eq "/" ){

    my $success = 0;
    my $user = $query->param('Username');
    my $pass = $query->param('Password');
    my $ver = $query->param('Version');
    my $id = time;

    print STDERR "reading password file\n" if $debug;
    open PASS, $passwd_file or die "cannot open passwd file: $passwd_file: $!";
    my %userpass = ();
    while( my $line = <PASS> ){
	if( $line !~ /\#.+/ && $line =~ /(.+)\s+(.+)/ ){
	    $userpass{$1} = $2;
	}
    }

    if( exists $userpass{$user} && 
	crypt($pass, $userpass{$user}) eq $userpass{$user} ){

	reply($success,"Version=$ver","SId=SId=$id","RSURL=$url/rs",
	      "CreateDirURL=$url/mkdir","UploadURL=$url/upload",
	      "DirListURL=$url/ls");
	print STDERR "sent login for $user\n" if $debug;
    }else{

	reply(1,"Version=$ver");
	print STDERR "failed login for $user\n" if $debug;
    }

}elsif( $uri eq "/rs" ){

    my $success = 0;

    reply($success,
	  "CreateDirURL=$url/mkdir","UploadURL=$url/upload",
	  "DirListURL=$url/ls");

    print STDERR "sent rs\n" if $debug;


}elsif($uri eq "/ls" ){

    my $id = $query->param('SId');

    print STDERR "getting a dir listing\n" if $debug;
    my $errcode = 0;
    opendir(LDIR, $localdir) or die "cannot open directory $localdir for reading\n";

    # get a filelisting and remove "." and ".."
    my @files = ();
    @files = grep { !/^\.{1,2}$/ } readdir( LDIR );
    close DIR;

    my $lines_per_dir = 2;
    my @dirs = ();
    
    my $count = 0;
    foreach my $dir (@files){
	if( -d "$localdir$dir" ){
	    push @dirs, "DId=$dir";
	    push @dirs, "DirName=$dir";
	    $count++;
	}
    }

    reply($errcode,$count,$lines_per_dir,@dirs,"SId=SId=$id");

}elsif($uri eq "/mkdir" ){
    my $dirname = $query->param('DirName');
    print STDERR "making directory $dirname\n" if $debug;

    my $success = 0;
    $success = mkdir( "$localdir/$dirname" ) ? 0 : 1;

    if( $success == 0 ){
	reply($success,"Did=$dirname");
    }else{
	reply($success,$!);
    }

}elsif($uri eq '/upload'){
    $filedir = $query->param('DirId');
    $filename = $query->param('Filename');
    my $id = $query->url_param('SId');
    my $image = $query->param('ImageData');

    print STDERR "attempting to upload $filename to dir $filedir\n" if $debug;

    my $writefile = "$localdir/$filedir/$filename";
    if( -e $writefile ){
	print STDERR "warning: file exists. Attempting to find a new name\n";
	do{
	    $writefile =~ s/(?:_(\d+))?\.(\w+)$/"_".($1+1).".$2"/e;
	}    while( -e $writefile );
	print STDERR "found: $writefile\n";
    }
    # store the file
    my $result = open (OUTFILE,">$writefile");

    print OUTFILE $image;
    close OUTFILE;
    $result = $result ? 0 : 1;
    reply($result,"Free=12345");

    if( $gallery_ping ){
	my $ua = LWP::UserAgent->new;
	my $req = HTTP::Request->new(GET => template($gallery_ping) );
	# query and ignore the results
	$ua->request($req);
    }

    generate_blosxom( $id, $filename, $filedir );

}else{
    print STDERR "client sent something I didn't understand\n";
    print STDERR "Params: ".Dumper($query->param() );
}

sub reply{
    my ($success, @re) = @_;

    my $rep = "";
    $rep .= "$success\r\n";
    $rep .= join "\r\n", @re;
    $rep .= "\r\n";

    print "Content-Type: text/plain; charset=utf-8\r\n";
    print "Content-Length: ".length($rep)."\n\n";
    print $rep;

    if( $debug ){
	print STDERR "Content-Length: ".length($rep)."\n\n";
	print STDERR $rep;
    }
}

sub generate_blosxom{

    my ($time, $filename, $filedir) = @_;

    return unless $use_blosxom;

    my $file = strftime( $blosxom_filename, localtime( $time ) );
    $file = $blosxom_dir.$file;

    my $out = "";
    # if a file's already there, open it and read it in so we can "append"
    if( -e $file ){
	open (BLFILE, "<", $file) or die "cannot open $file for reading: $!\n";
	$out = join "", <BLFILE>;
	close BLFILE;

	# set $seemore to $blosxom_seemore if it's not in the body already
	my $seemore = (( $out =~ /$blosxom_seemore/s ) 
	    ? "" : $blosxom_seemore);

	# toss the post in where the placeholder is, putting in a seemore if 
	# needed
	$out =~ s/$blosxom_placeholder/$seemore.template($blosxom_post).$blosxom_placeholder/e;
    }else{
	$out .= template($blosxom_head);
	$out .= template($blosxom_post);
	$out .= $blosxom_placeholder;
	$out .= template($blosxom_foot);
    }

    open (BLFILE, ">", $file) or die "cannot open $file for writing: $!\n";
    print BLFILE $out;
    close BLFILE;

}

sub template{
    my ($template) = @_;
    $template =~ 
        s/(\$\w+(?:::)?\w*)/"defined $1 ? $1 : ''"/gee;

    return $template;
}