#!/usr/bin/perl -wT # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- # # data: The data: URI kitchen # # 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 CGI::Carp; use HTML::Entities; use MIME::Base64; use URI::Escape; use LWP::UserAgent; # collect data from user my $query = CGI->new(); my $type = $query->param('type') || ''; my $base64 = $query->param('base64') || '0'; my $content = $query->param('content') || ''; my $typeFromFile = $query->param('typeFromFile') || '0'; my $file = $query->upload('file'); my $uri = $query->param('uri') || undef; my $ignoreErrors = $query->param('ignoreErrors') || 0; if ((defined $file ? -s $file : length $content) > 8*1024) { print <uploadInfo($query->param('file'))->{'Content-Type'}; $type = $filetype if defined $filetype; } $type =~ m/^ *([-+_a-zA-Z0-9]+\/[-+_a-zA-Z0-9]+(?:;[-+_=:*; a-zA-Z0-9]*)?) *$/; $type = $1; if ($type) { if (defined($file)) { local $/ = undef; $content = <$file>; } elsif (defined($uri)) { my $ua = LWP::UserAgent->new(); $ua->protocols_allowed(['http', 'https']); my $request = HTTP::Request->new(GET => $uri); my $response = $ua->request($request); if ($response->is_error && not $ignoreErrors) { my $message = $response->status_line; foreach ($uri, $type, $base64, $message) { $_ = encode_entities($_); } print < The data: URI kitchen: Error

The data: URI kitchen: Error

The URI you provided:

$uri

...is not working:

$message

end exit; } $content = $response->content; $type = $response->content_type || $type; } #savelog($content, $type); my $result = "data:$type"; if ($base64) { $result .= ';base64'; $content = encode_base64($content, ''); } $result .= ',' . uri_escape($content); # warn sprintf("Created a %d byte data: URI: %s\n", length($result), $result); my $resultEscaped = encode_entities($result); # Apache (at least the version this script was originally written # for) uses, it appears, an 8kb buffer when parsing headers # generated by scripts. # # This means that the longest URI that can be successfully sent # back using Location: headers is 8kb less the trailing CRLF less # the leading "Location: ", namely 8 * 1024 - 12 bytes. # # If it is longer than that, we'll just give the user a link. my $comment = ''; if (length($result) < 8 * 1024 - 12) { print "Status: 303 See Other\nLocation: $result\n"; $comment = "

(Your browser should have redirected you automatically. If you see this it probably has a bug.)

\n"; } else { print "Status: 200 OK\n"; } print < The data: URI kitchen: Results $comment

$resultEscaped

end } else { my $default = encode_entities(< Test

end print < The data: URI kitchen

See RFC 2387. Privacy policy: All activity is logged, but only serious abuse will be publicised.

HTML4.0 DOCTYPE: <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
XHTML1 namespace: http://www.w3.org/1999/xhtml

end } sub savelog { my($file, $type) = @_; my $directory = '/home/ianh/hixie.ch/software/utilities/cgi/data/files/'; opendir(DIRECTORY, $directory) or return; my $filename = 1; foreach my $file (grep { /^file-[0-9]+-/ } readdir(DIRECTORY)) { $file =~ m/^file-([0-9]+)-/os; if ($filename <= $1) { $filename = $1 + 1; } } my $note = ''; $filename = "file-$filename-"; if ($type =~ m|^image/p?jpeg$|osi) { $filename .= '.jpeg'; } elsif ($type =~ m|^image/gif$|osi) { $filename .= '.gif'; } elsif ($type =~ m|^image/(?:x-)?png$|osi) { $filename .= '.png'; } elsif ($type =~ m|^image/bmp$|osi) { $filename .= '.bmp'; } elsif ($type =~ m|^image/(?:x-)?icon?$|osi) { $filename .= '.ico'; } elsif ($type =~ m|^image/svg+xml(?: *;.*)?$|osi) { $filename .= '.svg'; } elsif ($type =~ m|^audio/wav$|osi) { $filename .= '.wav'; } elsif ($type =~ m|^audio/mpeg$|osi) { $filename .= '.mp3'; } elsif ($type =~ m|^video/mpeg$|osi) { $filename .= '.mpeg'; } elsif ($type =~ m|^text/html(?: *;.*)?$|osi) { $filename .= '.html'; } elsif ($type =~ m|^text/css(?: *;.*)?$|osi) { $filename .= '.css'; } elsif ($type =~ m|^text/plain(?: *;.*)?$|osi) { $filename .= '.txt'; } elsif ($type =~ m|^text/javascript(?: *;.*)?$|osi) { $filename .= '.js'; } elsif ($type =~ m|^text/xml(?: *;.*)?$|osi) { $filename .= '.xml'; } elsif ($type =~ m|^application/pdf$|osi) { $filename .= '.pdf'; } elsif ($type =~ m|^application/rtf$|osi) { $filename .= '.rtf'; } elsif ($type =~ m|^application/xml(?: *;.*)?$|osi) { $filename .= '.xml'; } elsif ($type =~ m|^application/octet-stream$|osi) { $filename .= '.bin'; } elsif ($type =~ m|^application/(?:x-)?zip(?:-compressed)?$|osi) { $filename .= '.zip'; } elsif ($type =~ m|^application/(?:x-)?(?:font-)?ttf$|osi) { $filename .= '.ttf'; } elsif ($type =~ m|^application/x-shockwave-flash$|osi) { $filename .= '.swf'; } elsif ($type =~ m|^application/msword$|osi) { $filename .= '.doc'; } elsif ($type =~ m|^font/(?:x-)?(?:font-)?ttf$|osi) { $filename .= '.ttf'; } else { $note = "# unknown type: $type\n"; } closedir(DIRECTORY); open(OUTPUT, ">$directory$filename") or return; print OUTPUT $file; close(OUTPUT); open(HTACCESS, ">>${directory}.htaccess") or return; $ENV{REMOTE_ADDR} =~ m/^([^\n\r]*)$/gos; my $ip = $1; $ENV{HTTP_USER_AGENT} =~ m/^([^\n\r]*)$/gos; my $ua = $1; print HTACCESS "# IP: $ip\n# User-Agent: $ua\n$note\n ForceType $type\n\nAddDescription \"$type from $ip\" $filename\n\n"; close(HTACCESS); }