1#!/usr/local/bin/perl -w 2# 3# Nonsense -- Generates random text from recursive datafiles. 4# 5# See the README for full details. 6# 7# Author: James Baughn, nonsense@i-want-a-website.com 8# with CGI support contributed by Fred Hirsch, truehand@darkhart.com 9# with small changes contributed by Peter Suschlik, peter@zilium.de 10# 11# Homepage: http://i-want-a-website.com/about-linux/downloads.shtml 12# Version: 0.5 (December 21, 2000) 13# License: GNU General Public License 2.0 14# 15# COMMAND LINE USAGE: 16# nonsense [ -f file.data ] [ -t file.template ] 17# [ -n number ] [ -p ] [ -b bullet string ] [ -e ] 18# [ -D | -d ] [ command string ] 19# 20# -f Specify a datafile to load in. Use multiple -f parameters 21# to include additional files. The default.data file is 22# is always loaded. 23# -F Load all data files (i.e. all files in the current directory 24# with a .data extension). 25# 26# -t Use a template 27# 28# -n Repeat n times 29# -p Separate each item with a blank line (i.e. paragraph break) 30# -b Specify a "bullet" to go in front of each item. 31# 32# -e Disable direct eval()'s 33# 34# -d Debug mode (shows each substituation) 35# -D Verbose debug mode (shows each substitution and the result) 36# 37###################################################################### 38 39use strict; 40use POSIX qw( strftime ); # Just in case somebody needs the date 41use CGI; 42 43my $PREFIX = "/usr/local"; 44my $datadir = "$PREFIX/share/nonsense/data"; 45my $templatedir = "$PREFIX/share/nonsense/template"; 46 47my %pool; # Where the datafiles are slurped into 48my %static; # Hash of persistent data (to maintain state) 49 50my $ignoreparameters = 0; # Set this to 1 if you want Nonsense to ignore 51 # command-line or CGI parameters (for security 52 # reasons). The program will use the hard-coded 53 # defaults below. See the README first! 54my @datafiles = qw(default.data); 55my $DEBUG = 0; 56my $template = '{Default}'; 57my $template_meta = ''; 58my $cgi_mode = 0; 59my $output_mode = 'text'; 60my $header = ''; 61my $footer = ''; 62my $spacer = "\n"; 63my $bullet = ''; 64my $iters = 1; 65my $evalokay = 1; # By default, allow direct eval 66my $query; 67 68if (@ARGV <= 0) { # Is this in a CGI environment? 69 $query = new CGI; 70 $output_mode = 'html'; $cgi_mode = 1; 71 $spacer = "<BR>\n"; 72 $evalokay = 0; # Just to be safe, disable this feature 73 # in CGI scripts 74} 75 76## Read CGI parameters 77if (defined $query && $query->param && !$ignoreparameters) { 78 my $cmd; 79 if (defined $query->param('cmd') && $query->param('cmd') ne "") { 80 $cmd = $query->param('cmd'); 81 } else { 82 $cmd = 'Default'; 83 } 84 if (defined $query->param('debug') && $query->param('debug') ne "") { 85 $DEBUG = $query->param('debug'); 86 } 87 if (defined $query->param('number') && $query->param('number') ne "") { 88 $iters = $query->param('number'); 89 } 90 if (defined $query->param('file') && $query->param('file') ne "") { 91 push (@datafiles, $query->param('file')) ; 92 } 93 if (defined $query->param('allfiles') && $query->param('allfiles') ne "") { 94 @datafiles = GlobCurrentDirectory(); 95 } 96 if (defined $query->param('template') && $query->param('template') ne "") { 97 my $file = $query->param('template'); 98 ($template, $template_meta) = LoadTemplate( $file ); 99 if( $file !~ /\.html/ ) { $output_mode = 'verbatim'; } 100 } else { 101 $template = '{' . ucfirst( $cmd ) . '}'; 102 if (defined $query->param('standalone') && $query->param('standalone') ne "") { 103 $header = "<HTML><HEAD><TITLE>Nonsense</TITLE></HEAD><BODY>\n"; 104 $footer = "</BODY></HTML>\n"; 105 } 106 } 107 if (defined $query->param('spacer') && $query->param('spacer') ne "") { 108 $spacer = $query->param('spacer' ); 109 if( $spacer eq 'P' || $spacer eq 'p' ) { 110 $spacer = "\n<P>\n"; 111 } elsif( $spacer =~ /^nl*$/i ) { 112 $spacer = "\n"; 113 } elsif( $spacer =~ /^br*$/i ) { 114 $spacer = "<BR>\n"; 115 } else { # Literal 116 $spacer = s/\\n/\n/g; 117 } 118 } 119 if (defined $query->param('bullet') && $query->param('bullet') ne "") { 120 my $layout = $query->param('bullet' ); 121 if( $layout =~ /^o/i ) { 122 $header .= "<OL>\n"; $footer = "</OL>\n$footer"; $bullet = "<LI>"; 123 } elsif( $layout =~ /^[ul]/i ) { 124 $header .= "<UL>\n"; $footer = "</UL>\n$footer"; $bullet = "<LI>"; 125 } 126 } 127 128## Read command line parameters 129} elsif(!$ignoreparameters) { 130 while( my $cmd = shift @ARGV ) { 131 if( $cmd =~ /^-(\w)/ ) { 132 my $switch = $1; 133 if( $switch eq 'd' ) { 134 $DEBUG = 1; 135 } elsif( $switch eq 'D' ) { 136 $DEBUG = 2; 137 } elsif( $switch eq 'n' ) { 138 $iters = shift @ARGV; 139 } elsif( $switch eq 'e' ) { 140 $evalokay = 0; 141 } elsif( $switch eq 'p' ) { 142 $spacer = "\n\n"; 143 } elsif( $switch eq 'b' ) { 144 $bullet = shift @ARGV; 145 } elsif( $switch eq 't' ) { 146 my $file = shift @ARGV; 147 ($template, $template_meta) = LoadTemplate( $file ); 148 } elsif( $switch eq 'f' ) { 149 push( @datafiles, shift @ARGV ); 150 } elsif( $switch eq 'F' ) { 151 @datafiles = GlobCurrentDirectory(); 152 } 153 } else { 154 $template = '{' . ucfirst( $cmd ) . '}'; 155 } 156 } 157} 158 159## Check if there was any meta-data specified in the template file 160if( $template_meta ne '' ) { 161 if( $template_meta =~ /prereq\w*:\s*(.*)\n/i ) { 162 my( @newfiles ) = split /\s*[,;]\s*/, $1; 163 push( @datafiles, @newfiles ); # Add new prerequisite datafiles 164 # to the list 165 } 166} 167 168foreach my $datafile ( @datafiles ) { 169 LoadDataFile( $datafile ); 170} 171 172if( $cgi_mode ) { 173 if( $output_mode eq 'html' ) { # HTML output 174 print $query->header; 175 } else { # Not an HTML template, treat as plain text 176 print $query->header( -type=>'text/plain' ); 177 } 178 print $header; 179} 180 181for( my $i = 0; $i < $iters; $i++ ) { 182 my $workcopy = $template; 183 $workcopy =~ s/{([^}]+)}/Pick($1)/eg; # The meat of the program 184 print "${bullet}${workcopy}${spacer}"; 185} 186 187print $footer if( $cgi_mode ); 188exit(0); # Done! 189 190######## SUBROUTINES ######################################################## 191 192### Recursively process a command 193sub Pick { 194 my $key = shift; 195 my $case; 196 my $pick; 197 198 ## Number range 199 if( $key =~ /^#(\d+)-(\d+)$/ ) { 200 $pick = int( rand( $2 - $1 ) + $1 ); 201 202 ## Current time (fed through strftime) 203 } elsif( $key =~ /^\@([^|]+)$/ ) { 204 $pick = strftime( $1, localtime( time ) ); 205 206 ## Time maintained by a state variable (and decreased by a random value) 207 } elsif( $key =~ /^\@(.*?)\|\$(\w+)\|(\d+)$/ ) { 208 my $usekey = uc $2; my $s = $1; my $t; 209 my $elapse = int( rand( $3 ) ); 210 if( exists $static{$usekey} ) { 211 $t = $static{$usekey} - $elapse; 212 } else { 213 $t = time - $elapse; 214 } 215 $pick = strftime( $s, localtime( $t ) ); 216 $static{$usekey} = $t; 217 218 ## Current time minus a random value 219 } elsif( $key =~ /^\@(.*?)\|(\d+)\|(\d+)$/ ) { 220 $pick = int( rand( $3 - $2 ) + $3 ); 221 $pick = strftime( $1, localtime( time - $pick ) ); 222 223 ## Direct eval (literal Perl code) -- Dangerous! 224 } elsif( $key =~ /^;(.*)$/ ) { 225 if( $evalokay ) { 226 $pick = eval( $1 ); 227 } else { 228 $pick = ''; 229 } 230 231 ## Literal list 232 } elsif( $key =~ /^\[(.*)$/ ) { 233 my @temp = split /\|/, $1; 234 if(scalar @temp > 1) { # More than one element 235 $pick = $temp[ rand @temp ]; 236 } else { # ...Or single element 237 $pick = int rand 2 ? shift @temp : ""; # Pick it or pick nothing 238 } 239 240 ## Embedded character 241 } elsif( $key =~ /^\\(.*)$/ ) { 242 $pick = EmbeddedCharacter( $1 ); 243 244 ## Assignment (state variable:=command) 245 } elsif( $key =~ /^(.*?):=(.*)$/ ) { 246 my $usekey = uc $1; $key = $2; 247 $static{$usekey} = Pick($key); $pick = ''; 248 249 ## Literal assignment (state variable=literal string) 250 } elsif( $key =~ /^(.*?)=(.*)$/ ) { 251 $key = $2; 252 $static{uc $1} = $key; $pick = ''; 253 254 ## Retrieve a state variable 255 } elsif( $key =~ /^[\$<](.*)$/ ) { 256 $case = $1; 257 my $usekey = uc $case; 258 $usekey =~ s/\W//g; # Strip special characters 259 if( !exists $static{$usekey} ) { 260 $pick = Pick($usekey); # Variable isn't defined 261 } else { 262 $pick = $static{$usekey}; 263 } 264 265 ## Pick something from the pool a random number of times [NEW] 266 } elsif( $key =~ /^(.*?)#(\d+)-(\d+)$/ ) { 267 my $usekey = $1; $pick = ''; 268 my $num = int( rand( $3 - $2 ) + $2 ); 269 foreach( my $i = 0; $i < $num; $i++ ) { 270 $pick .= Pick($usekey); 271 } 272 $case = $usekey; 273 274 ## Pick something from the pool (not a special case) 275 } else { 276 my $usekey = uc $key; 277 $usekey =~ s/\W//g; 278 if( !exists $pool{$usekey} ) { 279 print "{$usekey} not found\n"; $pick = ''; 280 } else { 281 $pick = $pool{ $usekey }[ rand @{ $pool{ $usekey } } ]; 282 $case = $key; 283 } 284 } 285 286 ## Print debugging info if necessary 287 if( $DEBUG == 1 ) { 288 if( $output_mode ne 'text' ) { 289 print "<!--$key-->"; # Output it as an unobtrusive HTML comment 290 } else { 291 print "[$key]"; 292 } 293 } elsif( $DEBUG == 2 ) { 294 if( $output_mode ne 'text' ) { 295 print "<!--$key=$pick-->\n"; 296 } else { 297 print "[$key=$pick]\n"; 298 } 299 } 300 301 ## Recursively process it 302 $pick =~ s/{([^}]+)}/Pick($1)/eg; 303 304 ## Handle lowercase/uppercase conversions 305 if( !defined $case ) { # No need to worry about case 306 return $pick; 307 } elsif( $case =~ /^[A-Z0-9]+$/ ) { # UPPERCASE 308 return uc $pick; 309 } elsif( $case =~ /^[a-z0-9]+$/ ) { # lowercase 310 return lc $pick; 311 } elsif( $case =~ /^\^/ ) { # begins with '^' -- Ucfirst 312 return ucfirst $pick; 313 } else { # Mixed Case -- don't touch case 314 return $pick; 315 } 316} 317 318### Return a literal character 319sub EmbeddedCharacter { 320 my $in = shift; 321 if( $in eq 'n' ) { # Newline 322 return "\n"; 323 } elsif( $in eq '0' ) { # Null 324 return ''; 325 } elsif( $in eq 'L' ) { # Left brace 326 return '{'; 327 } elsif( $in eq 'R' ) { # Right brace 328 return '}'; 329 } elsif( $in =~ /^\d+/ ) { # ASCII code in decimal 330 return chr( $in ); 331 } 332 return ''; # Character not in list 333} 334 335### Load and parse a datafile, slurping the contents into the %pool hash 336sub LoadDataFile { 337 my $file = shift; 338 $file = SafeFile( $file ) if $cgi_mode; 339 open IN, $file or open IN, "$datadir/$file" 340 or die "Error opening $file... $!\n"; 341 local $/ = ''; 342 343 SECTION: while( <IN> ) { 344 my( @temp ) = split /\n/, $_; 345 my $key = shift @temp; 346 $pool{$key} = [ @temp ]; 347 } 348 close IN; 349} 350 351### Slurp a template file into core 352sub LoadTemplate { 353 my $file = shift; 354 my $m = ''; 355 $file = SafeFile( $file ) if $cgi_mode; 356 open IN, $file or open IN, "$templatedir/$file" 357 or die "Error opening $file template... $!\n"; 358 local $/; undef $/; my $t = <IN>; 359 close IN; 360 if( $t =~ /__BEGIN__/ ) { # Check for a header 361 ($m, $t) = split /__BEGIN__\s/, $t, 2; 362 } 363 return( $t, $m ); 364} 365 366### Remove special characters from a filename to prevent maliciousness 367sub SafeFile { 368 my( $file ) = shift; 369 $file =~ s/([^\w.-])//g; # Ignore special characters except dots and hyphens 370 warn("[" . localtime() . "] [warning] [client $ENV{REMOTE_ADDR}] Attempt to override filename safety feature!") if $1; 371 return $file; 372} 373 374sub ListUniq { 375 my ($v, $last) = (undef, undef); 376 my @l = (); 377 378 foreach $v (@_) { 379 push (@l, $v) if (defined($last) && ($v ne $last)); 380 $last = $v; 381 } 382 return @l; 383} 384 385### Return all of the datafiles in the current directory 386sub GlobCurrentDirectory { 387 opendir(DIR, "."); 388 my @datafiles = grep { /\.data$/ } readdir(DIR); 389 closedir(DIR); 390 opendir(DIR, "$datadir"); 391 push(@datafiles, grep { /\.data$/ } readdir(DIR)); 392 closedir(DIR); 393 return ListUniq(sort @datafiles); 394} 395