#!/usr/bin/perl
#
# randstring.pl - Generates a random string from a pattern
# Copyright (C) 1998 Steven Pritchard <steve@silug.org>
#
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# 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.

use strict;
use vars qw($foo $string @upper @lower @digit @punct @any @salt);

use English; # For readability
use FileHandle;

@upper=("A".."Z");
@lower=("a".."z");
@digit=("0".."9");
@punct=qw(! @ # $ % ^ & * , . ; : ' " - _ + =);
@any=(@upper, @lower, @digit, @punct);
@salt=(@upper, @lower, @digit, ".", "/");

$string=shift;
if (!$string)
{
    &usage;
    exit 0;
}

if ($OSNAME eq "linux") # Should add tests for other systems with /dev/*random
{
    # Read our seed from /dev/urandom
    my $urandom=new FileHandle "</dev/urandom";
    if ($urandom)
    {
	my($foo,$seed);

	sysread $urandom, $foo, 4;
	$seed=unpack "L", $foo;
	srand($seed);
    }
    else
    {
	my @foo;

	print STDERR <<MSG;
You need to upgrade to a newer kernel or create the device /dev/urandom.
Calling srand() with no arguments will result in a @{
    [ (($PERL_VERSION < 5.004) ? "not very" : "somewhat") ]
} random seed.
MSG
	srand;
    }
}
elsif ($PERL_VERSION < 5.004) # Seeding is not necessary in newer versions.
{
    # This was chosen very arbitrarily.  It seems
    # to generate some reasonably random numbers.
    # It should probably be tested more thoroughly.
    my $seed=($BASETIME * $PID) ^ $BASETIME ^ 0xffffffff;
    # Gather up some entropy from the environment, hopefully.
    for (keys(%ENV))
    {
	my $foo=$ENV{$_};
	$foo+=0;
	$seed=$seed^$foo;
    }
    srand($seed);
}

print &random_string($string), "\n";

sub usage
{
    my @foo;

    print STDERR <<END;
Usage: @{ [ &basename($0) ] } <pattern>

Characters in pattern must be one of the following:

	c	Any lowercase character [a-z]
	C	Any uppercase character [A-Z]
	n	Any digit [0-9]
	!	A punctuation character [@{ [ join("",@punct) ] }]
	.	Any of the above
	s	A "salt" character [A-Za-z0-9./]

END
}

sub basename
{
    my($name)=@_;
    return $name=~/\// ? substr($name,(-1*length($name))+(rindex($name, "/")+1)) : $name;
}

sub random_string
{
    my($pattern)=@_;

    my($n,$string);

    for ($n=0;$n<length($pattern);$n++)
    {
	$_=substr($pattern, $n, 1);

	if (/\./)
	{
	    s/\./$any[int(rand(scalar(@any)))]/;
	}
	elsif (/C/)
	{
	    s/C/$upper[int(rand(scalar(@upper)))]/;
	}
	elsif (/c/)
	{
	    s/c/$lower[int(rand(scalar(@lower)))]/;
	}
	elsif (/n/)
	{
	    s/n/$digit[int(rand(scalar(@digit)))]/;
	}
	elsif (/s/)
	{
	    s/s/$salt[int(rand(scalar(@salt)))]/;
	}
	elsif (/!/)
	{
	    s/!/$punct[int(rand(scalar(@punct)))]/;
	}
	else
	{
	    print STDERR qq(Unknown pattern character "$_"!\n);
	    exit 1;
	}
	$string.=$_;
    }
    return $string;
}