summaryrefslogtreecommitdiff
path: root/eg/scan/scanner
diff options
context:
space:
mode:
authorLarry Wall <larry@wall.org>1988-06-05 00:00:00 +0000
committerLarry Wall <larry@wall.org>1988-06-05 00:00:00 +0000
commit378cc40b38293ffc7298c6a7ed3cd740ad79be52 (patch)
tree87bedf9adc5c88847a2e2d85963df5f94435aaf5 /eg/scan/scanner
parenta4de7c03d0bdc29d9d3a18abad4ac2628182ed7b (diff)
downloadperl-378cc40b38293ffc7298c6a7ed3cd740ad79be52.tar.gz
perl 2.0 (no announcement message available)perl-2.0
Some of the enhancements from Perl1 included: * New regexp routines derived from Henry Spencer's. o Support for /(foo|bar)/. o Support for /(foo)*/ and /(foo)+/. o \s for whitespace, \S for non-, \d for digit, \D nondigit * Local variables in blocks, subroutines and evals. * Recursive subroutine calls are now supported. * Array values may now be interpolated into lists: unlink 'foo', 'bar', @trashcan, 'tmp'; * File globbing. * Use of <> in array contexts returns the whole file or glob list. * New iterator for normal arrays, foreach, that allows both read and write. * Ability to open pipe to a forked off script for secure pipes in setuid scripts. * File inclusion via do 'foo.pl'; * More file tests, including -t to see if, for instance, stdin is a terminal. File tests now behave in a more correct manner. You can do file tests on filehandles as well as filenames. The special filetests -T and -B test a file to see if it's text or binary. * An eof can now be used on each file of the <> input for such purposes as resetting the line numbers or appending to each file of an inplace edit. * Assignments can now function as lvalues, so you can say things like ($HOST = $host) =~ tr/a-z/A-Z/; ($obj = $src) =~ s/\.c$/.o/; * You can now do certain file operations with a variable which holds the name of a filehandle, e.g. open(++$incl,$includefilename); $foo = <$incl>; * Warnings are now available (with -w) on use of uninitialized variables and on identifiers that are mentioned only once, and on reference to various undefined things. * There is now a wait operator. * There is now a sort operator. * The manual is now not lying when it says that perl is generally faster than sed. I hope.
Diffstat (limited to 'eg/scan/scanner')
-rw-r--r--eg/scan/scanner87
1 files changed, 87 insertions, 0 deletions
diff --git a/eg/scan/scanner b/eg/scan/scanner
new file mode 100644
index 0000000000..25e953d402
--- /dev/null
+++ b/eg/scan/scanner
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
+
+# This runs all the scan_* routines on all the machines in /etc/ghosts.
+# We run this every morning at about 6 am:
+
+# !/bin/sh
+# cd /usr/adm/private
+# decrypt scanner | perl >scan.out 2>&1
+# mail admin <scan.out
+
+# Note that the scan_* files should be encrypted with the key "-inquire", and
+# scanner should be encrypted somehow so that people can't find that key.
+# I leave it up to you to figure out how to unencrypt it before executing.
+
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
+
+$| = 1; # command buffering on stdout
+
+print "Subject: bizarre happenings\n\n";
+
+(chdir '/usr/adm/private') || die "Can't cd.";
+
+if ($#ARGV >= 0) {
+ @scanlist = @ARGV;
+} else {
+ @scanlist = split(/[ \t\n]+/,`echo scan_*`);
+}
+
+scan: while ($scan = shift(@scanlist)) {
+ print "\n********** $scan **********\n";
+ $showhost++;
+
+ $systype = 'all';
+
+ open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
+
+ $one_of_these = ":$systype:";
+ if ($systype =~ s/\+/[+]/g) {
+ $one_of_these =~ s/\+/:/g;
+ }
+
+ line: while (<ghosts>) {
+ s/[ \t]*\n//;
+ if (!$_ || /^#/) {
+ next line;
+ }
+ if (/^([a-zA-Z_0-9]+)=(.+)/) {
+ $name = $1; $repl = $2;
+ $repl =~ s/\+/:/g;
+ $one_of_these =~ s/:$name:/:$repl:/;
+ next line;
+ }
+ @gh = split;
+ $host = $gh[0];
+ if ($showhost) { $showhost = "$host:\t"; }
+ class: while ($class = pop(gh)) {
+ if (index($one_of_these,":$class:") >=0) {
+ $iter = 0;
+ `exec crypt -inquire <$scan >.x 2>/dev/null`;
+ unless (open(scan,'.x')) {
+ print "Can't run $scan.";
+ next scan;
+ }
+ $cmd = <scan>;
+ unless ($cmd =~ s/#!(.*)\n/$1/) {
+ $cmd = '/usr/bin/perl';
+ }
+ close(scan);
+ if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
+ sleep(5);
+ unlink '.x';
+ while (<pipe>) {
+ last if $iter++ > 1000; # must be looping
+ next if /^[0-9.]+u [0-9.]+s/;
+ print $showhost,$_;
+ }
+ close(pipe);
+ } else {
+ print "(Can't execute rsh.)\n";
+ }
+ last class;
+ }
+ }
+ }
+}