#!/usr/bin/perl -wT # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- # # uploader: A simple uploader script # # Copyright (c) 2002 by Ian Hickson # # 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 use strict; use CGI; use HTML::Entities; # collect data from user my $query = CGI->new(); my $type = $query->param('type') || ''; my $password = $query->param('password') || ''; my $content = $query->param('content') || ''; my $file = $query->upload('file'); if ($type =~ m|^[-.+a-z0-9]+/[-.+a-z0-9]+(?:;charset=[-.+a-z0-9]+)?$|osi) { if (defined($file)) { local $/ = undef; $content = <$file>; } if (my $uri = upload($content, $type, $password)) { my $uriE = encode_entities($uri); print < Uploader: File uploaded

File uploaded.

$uriE

end ################################################################################ # LOG AS MUCH INFORMATION AS POSSIBLE # ################################################################################ use Net::SMTP; my $handle = Net::SMTP->new('mail.software.hixie.ch', 'Timeout' => 5); my $size = length($content); delete $ENV{'PATH'}; my $addr = clean($ENV{REMOTE_ADDR}); my $host = `/usr/bin/host $addr`; $host =~ s/\n+$//os; $handle->mail('ian@hixie.ch'); $handle->to('ian@hixie.ch'); $handle->data(< From: Uploader Subject: File uploaded: $uri Hi Ian, Someone just uploaded a file. User-Agent: $ENV{HTTP_USER_AGENT} $host Location: $uri Content-Type: $type Content-Length: $size Body: -------------------------------------------------------------------------------- $content -------------------------------------------------------------------------------- Hope that helps, -- Ian Hickson END_OF_DATA print STDERR "\n"; print STDERR '=' x 80; print STDERR "\nFile uploaded.\n"; print STDERR '-' x 80; print STDERR "\n"; foreach my $key (sort keys %ENV) { print STDERR "$key = $ENV{$key}\n"; } print STDERR "LOCATION = $uri\nTYPE = $type\nSIZE = $size\n"; print STDERR '=' x 80; print STDERR "\n"; ################################################################################ # YOU ARE NOW LEAVING PARANOIA CITY # ################################################################################ } else { print < Uploader: Failed

Please contact me if you think this should have worked.

end } } else { print < Uploader

Uploader

MIME Type:

Password:

end } sub upload { my($file, $type, $password) = @_; open(CONFIG, '<.config') or die "Couldn't open configuration file: $!"; my $expectedPassword = ; die "Couldn't read password from configuration file: $!" unless defined($password); my $directory = ; die "Couldn't read upload directory from configuration file: $!" unless defined($directory); my $uriPrefix = ; die "Couldn't read URI prefix from configuration file: $!" unless defined($uriPrefix); $expectedPassword = clean($expectedPassword); $directory = clean($directory); $uriPrefix = clean($uriPrefix); close(CONFIG) or die "Couldn't close configuration file: $!"; if ($directory !~ m|^/.*/$|os) { die "Malformed upload directory in config file: '$directory' doesn't start and end with a slash"; } return if ($password ne $expectedPassword); opendir(DIRECTORY, $directory) or die "Couldn't open upload directory '$directory': $!"; # get highest numbered entry in directory my $filename = 1; foreach my $file (grep { /^[0-9]+$/ } readdir(DIRECTORY)) { if ($filename <= $file) { $filename = clean($file + 1); } } closedir(DIRECTORY) or die "Couldn't close upload directory '$directory': $!"; open(OUTPUT, ">$directory$filename") or die "Couldn't open output file: $!"; print OUTPUT $file; close(OUTPUT) or die "Couldn't close output file: $!"; open(HTACCESS, ">>${directory}.htaccess") or die "Couldn't open .htaccess file: $!"; print HTACCESS "\n ForceType $type\n\n\n"; close(HTACCESS) or die "Couldn't close .htaccess file: $!"; return "$uriPrefix$filename"; } sub clean { my($data) = @_; $data =~ m/^(.*?)\n?$/os; return $1; }