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