$WEB_SERVER = "http://your.server.com"; $ABS_PATH = '/var/www/htdocs'; $FONT_DIRECTORY = '/usr/share/fonts/default/TrueType'; $HTTP_SECURITY_IMAGE_DIR = $WEB_SERVER . '/images/security'; $ABS_SECURITY_IMAGE_DIR = $ABS_PATH . '/images/security'; sub get_secret_word { # best way to set up allowed char array dropping i l o I O 0 1 chars # these chars look very similar my @chars = ( 'a'..'h', 'j', 'k', 'm', 'n', 'p'..'z', 'A'..'H', 'J'..'N', 'P'..'Z', 2..9 ); my $secret_word = $chars[rand @chars]; $secret_word .= $chars[rand @chars] for 1..4; # generate hash of secret word my $secret_word_hash = generate_MD5_hash(lc($secret_word)); return $secret_word, $secret_word_hash; } sub generate_MD5_hash { my ( $plain_text ) = @_; $plain_text = '' unless defined $plain_text; require Digest::MD5; return Digest::MD5->new->add( $plain_text . 'Secret=GNUisnotunix' )->hexdigest; } sub write_secret_word_image { my ( $word, $hash ) = @_; # make the dir from the script, silent failure if it already exists mkdir $ABS_SECURITY_IMAGE_DIR; require GD; # add the text string $word = join ' ', split //, $word; my $font = select_font(); my $temp_im = new GD::Image(); my $temp_green = $temp_im->colorAllocate(0,255,0); # get bounds my @bounds = GD::Image->stringFT( $temp_green, $font, 20.0, 0.0, 0, 0, $word ); my $x_bound = $bounds[4]; my $y_bound = abs($bounds[5]); my $i_x = $x_bound + 20; my $i_y = $y_bound + 20; # create a new image my $im = new GD::Image($i_x, $i_y); my $green = $im->colorAllocate(0,255,0); my $black = $im->colorAllocate(0,0,0); @bounds = $im->stringFT( $black, $font, 20.0, 0.0, 10, $i_y - 10, $word ); open IMG, ">$ABS_SECURITY_IMAGE_DIR/$hash.png" or ui_system_error( "Can't write security image $!\n" ); # make sure we are writing to a binary stream binmode STDOUT; binmode IMG; # Convert the image to PNG and print it on standard output print IMG $im->png; close IMG; return "$HTTP_SECURITY_IMAGE_DIR/$hash.png", $i_x, $i_y, $x_bound, $y_bound; } sub select_font { my @fonts = <$FONT_DIRECTORY/*.ttf>; die "No fonts in directory $FONT_DIRECTORY" unless @fonts; my @fontlist; for my $font (@fonts) { push @fontlist, $font unless $font =~ m/star/; } return $fontlist[rand @fontlist]; } __END__ cd freetype-2.1.4 ./configure make make install cd ../gd-2.0.15 ./configure make make install cd GD-x.x perl Makefile.PL && make && make test && make install