#
#
#
# init
my($CDIR) = $0;
$CDIR =~ s/\\([^\\]*)$//;
require $CDIR.'\\.config';
# global values
my(%PARAM, %CACHE, @CACHE, $ref);
GetRequest();
ReadCache();
ImageLink();
if ($ENV{'HTTP_REFERER'} ne '') {
$ref = $ENV{'HTTP_REFERER'};
} else {
$ref = $ENV{'URL'};
$ref =~ s![^/]*$!!;
}
print "HTTP/1.0 203 Non-Authoritative\r\n";
#print "Location: $ref\r\n";
print "\r\n";
print "WARNING";
print "直リンクは禁止しています。20秒後に '$ref' へ戻ります。";
exit;
#-----------------------------------------------------------------------------
#
#-----------------------------------------------------------------------------
sub GetRequest
{
undef %PARAM;
foreach (split('&', $ENV{'QUERY_STRING'})) {
my($key, $value) = split('=', $_);
$value =~ s/\+/ /gox;
$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('C',hex($1))/geox;
$PARAM{$key} = $value;
}
}
#-----------------------------------------------------------------------------
sub ReadCache
{
open(CACHE, $CDIR.$IMAGE_DIR.'cache.log');
while () {
chomp;
my(@data) = split(',', $_);
next if (($data[0] =~ /^id/) ||
($data[10] ne '' && index($PARAM{'key'}, encrypt($data[10])) == -1));
push @CACHE, $_;
$CACHE{$data[0]} = $#CACHE;
}
close(CACHE);
}
#-----------------------------------------------------------------------------
sub ImageLink
{
my($Ktai) = ($ENV{'HTTP_USER-AGENT'} =~ /^DoCoMo/);
if ($AVOID_IMGLINK) {
my($key) = encrypt(sprintf('%X', unpack('N', pack('c*', split('\.', $ENV{'REMOTE_ADDR'}))) >> 8));
my($cookie) = ($ENV{'HTTP_COOKIE'} =~ /\s?$key=([^;]*)/);
$cookie = $PARAM{$key} if $cookie eq '';
return if (time-$cookie > 20*60) && index($ENV{'HTTP_REFERER'}, "://$ENV{'HTTP_HOST'}/") == -1;
}
if (exists $PARAM{'id'}) {
return if $CACHE{$PARAM{'id'}} eq '';
my(@data) = split(/,/, $CACHE[$CACHE{$PARAM{'id'}}]);
my($file) = $data[0].$data[1];
if ($Ktai || $PARAM{'thumb'} == 1) {
my($org) = $file;
$file =~ s/\.[^.]*$/-thumb.jpg/;
if (!-e $CDIR.$IMAGE_DIR.$file) {
`$CDIR.$IMAGE_DIR.\\i_view32.exe $CDIR$IMAGE_DIR$org /silent /resample=(120,0) /convert=$CDIR$IMAGE_DIR$file`;
}
}
open(BIN, $CDIR.$IMAGE_DIR.$file);
binmode(BIN);
my($len) = -s BIN;
read(BIN, $buf, $len);
close(BIN);
print "HTTP/1.0 200 OK\r\n";
print "Content-Type: $data[2]\r\n";
print "Content-Disposition: filename=$file\r\n";
print "Content-Length: $len\r\n\r\n$buf";
exit;
}
}