#!/usr/bin/perl -Tw # Copyright (c) 2007, Gregory Fleischer (gfleischer@gmail.com) # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the # distribution. # 3. The names of the authors may not be used to endorse or promote # products derived from this software without specific prior # written permission. # # THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. use strict; my @mime_types = ('', 'application/x-www-form-urlencoded', 'multipart/form-data', 'text/plain', 'multipart/example', 'example/form-data', 'text/example', 'example/plain', 'example/example'); eval { my $content_type = $ENV{CONTENT_TYPE}; my $user_agent = $ENV{HTTP_USER_AGENT}; my $query = $ENV{QUERY_STRING}; my $method = $ENV{REQUEST_METHOD}; my $ut = undef; if ($user_agent=~/Linux/) { if ($user_agent=~/Konqueror/) { $ut = "Konqueror - Linux"; } elsif ($user_agent=~/Firefox/) { $ut = "Firefox - Linux"; } elsif ($user_agent=~/Opera/) { $ut = "Opera - Linux"; } } elsif ($user_agent=~/Mac.OS.X/) { if ($user_agent=~/Safari/) { $ut = "Safari - Mac OS X"; } elsif ($user_agent=~/Firefox/) { $ut = "Firefox - Mac OS X"; } elsif ($user_agent=~/Opera/) { $ut = "Opera - Mac OS X"; } } elsif ($user_agent=~/Windows/) { if ($user_agent=~/Safari/) { $ut = "Safari - Windows"; } elsif ($user_agent=~/Firefox/) { $ut = "Firefox - Windows"; } elsif ($user_agent=~/Opera/) { $ut = "Opera - Windows"; } elsif ($user_agent=~/MSIE.(\d)/) { $ut = "MSIE$1 - Windows"; } } elsif ($user_agent=~/MSIE.(\d).*Mac_PowerPC/) { $ut = "MSIE$1 - Mac OS X"; } if (!defined($ut)) { die "failed to calculate user-agent: $user_agent"; } if ("POST" eq $method) { unless ($query=~/^formEncoding=(.+)$/) { die "bad formEncoding: $query"; } my $ct = $1; $ct=~s/%([0-9a-fA-F]{2})/chr(hex($1))/ge; $ct=~s/\W/_/g; my $ua = lc($ut); $ua=~s/ //g; $ua=~s/-/_/; my $file = "sample/$ua-$ct.txt"; open(OF, ">", $file) or die $!; print OF "Content-Type: ", $content_type, "\n"; print OF "=" x 80, "\n"; while () { print OF $_; } print OF "\n"; close(OF); print "Content-Type: text/html; charset=us-ascii\n\n"; print "okay: $query"; } else { print "Content-Type: text/html; charset=us-ascii\n\n"; my $mt; if ($query=~/^(\d+)$/) { my $ndx = $1; $mt = $mime_types[$ndx]; if (!defined($mt)) { die "undefined mt: $query"; } my $et = $mt; if (!$et) { $et = "omitted"; } print ""; print "\n"; print "" } else { print "\n"; my $counter = 0; foreach $mt (@mime_types) { print "\n"; ++$counter; } print "\n"; } } }; if ($@) { print "Content-Type: text/plain; charset=us-ascii\n\n"; print $@; }