555cb01e5a
This code relies on the netpbm port being installed ; this is already a dependency of the textproc/docproj port. This comes courtesy of a collaboration with Eric Anderson <anderson@centtech.com> who submitted both the idea and the vast majority of the code to implement it; thank you very much, Eric - this is a great Christmas present to us and our user community.
82 lines
2.1 KiB
Perl
Executable file
82 lines
2.1 KiB
Perl
Executable file
#!/usr/bin/perl -T
|
|
#
|
|
# $FreeBSD$
|
|
#
|
|
# Copyright (c) 2003 Eric Anderson
|
|
|
|
use DB_File;
|
|
use Fcntl qw(:DEFAULT :flock);
|
|
use strict;
|
|
|
|
$ENV{"PATH"} = "/bin:/usr/bin";
|
|
$ENV{"TMPDIR"} = "/tmp";
|
|
|
|
my($fd, $db_obj, %db_hash, $currenttime, $randomcode, $pngbindata, $randompick, $pnmlist, $i);
|
|
my($expiretime, $pnmcat, $pnmtopng, $pnmdatadir, $dbpath);
|
|
|
|
############################################
|
|
# generate 8 charactor code from A-Z0-9 (no o,O,0)
|
|
my @availchars = qw(A B C D E F G H I J K L M N P Q R S T U V W X Y Z
|
|
1 2 3 4 5 6 7 8 9);
|
|
|
|
$pnmcat = "/usr/local/bin/pnmcat";
|
|
$pnmtopng = "/usr/local/bin/pnmtopng";
|
|
$pnmdatadir = "../gifs/";
|
|
$dbpath = "/tmp/sendpr-code.db";
|
|
$expiretime = 900; # seconds until code expires
|
|
############################################
|
|
|
|
$currenttime = time();
|
|
|
|
# DB stuff here
|
|
$db_obj = tie(%db_hash, 'DB_File', $dbpath, O_CREAT|O_RDWR, 0644)
|
|
or die "dbcreate $dbpath $!";
|
|
$fd = $db_obj->fd;
|
|
open(DB_FH, "+<&=$fd") or die "fdopen $!";
|
|
|
|
unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
|
|
unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
|
|
}
|
|
|
|
&gencode;
|
|
|
|
while ($db_hash{$randomcode}) {
|
|
# it already exists so:
|
|
# we check age (over x seconds old?)
|
|
# if it is, override with new date
|
|
# if not, generate a new code
|
|
if ( ($currenttime - $expiretime) <= $db_hash{$randomcode}) {
|
|
&gencode;
|
|
} else {
|
|
delete $db_hash{"$randomcode"};
|
|
}
|
|
}
|
|
|
|
$db_hash{$randomcode} = $currenttime;
|
|
|
|
$db_obj->sync(); # to flush
|
|
flock(DB_FH, LOCK_UN);
|
|
undef $db_obj; # removing the last reference to the DB
|
|
# closes it. Closing DB_FH is implicit.
|
|
untie %db_hash;
|
|
|
|
$/ = "";
|
|
|
|
open(BUILDPNG, "$pnmcat -lr $pnmlist | $pnmtopng 2>/dev/null |");
|
|
$pngbindata = <BUILDPNG>;
|
|
print "Content-type: image/png\n\n";
|
|
print "$pngbindata";
|
|
close(BUILDPNG);
|
|
|
|
############################################
|
|
sub gencode {
|
|
srand( time() ^ ($$ + ($$ << 15)) );
|
|
|
|
for ($i = 0; $i < 8; $i++) {
|
|
$randompick = $availchars[int(rand(@availchars))];
|
|
$randomcode .= "$randompick";
|
|
$pnmlist .= "$pnmdatadir$randompick\.pnm ";
|
|
}
|
|
}
|
|
|
|
|