🚀 go-pugleaf

I'm getting tired of these messy-windows posts.  So, I thought I'd
post some actual (working, I hope) NeWS code.

These two utilities that follow arose out of a desire to let naive
OpenLook users shutdown the machine and access the floppy drive.  I
used perl to do the script-like stuff and NeWS/TNT for the front-end.
I thought this was sorta neat.

They run under OW3.0 and need perl4.? or later.  Let me know how they
work.

Rob Kroeger, rjkroege@watcgl.uwaterloo.ca
CGL
University of Waterloo

Cut Here----------------------------------------------------
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README floppy.pl shutdown
# Wrapped by rjkroege@mud on Mon Jan 11 15:22:59 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(778 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XShutdown Tool  - shutdown
XLets someone shutdown the machine.  Make sure you change the hardcoded name of
Xthe machine being shutdown.  Doesn't bother checking if anybody is logged in.
X
XDiskette Tool - floppy.pl
XLets someone eject, mount, unmount and format both pcfs and 4.2 filesystem disks.
XNote that filemgr dies a slow but painful death if you use it to visit a removable 
Xvolume.
X
X
XBoth tools are not too particular about security.
X
XSome Legal Mumbojumbo.
XThese tools are mine.  You can do whatever you want with them with the following
Xexceptions:
X
X1. If you change the tool(s), make sure that my name stays present.
X2. You may not make money from these tools without having a specific prior arrangement
X    with me.
X
XEnjoy and let me know it they're useful/interesting.
X
END_OF_FILE
if test 778 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'floppy.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'floppy.pl'\"
else
echo shar: Extracting \"'floppy.pl'\" \(7266 characters\)
sed "s/^X//" >'floppy.pl' <<'END_OF_FILE'
X#!/usr/local/bin/taintperl
X# a perl script
X# Copyright 1992, Robert Kroeger
X
X# Program modified for better security
X$ENV{'PATH'} = '/bin:/usr/bin:/usr/etc:/usr/etc/bin:/usr/openwin/bin';
X
Xsub doForkStuff {
X    pipe ( CREAD, PWRITE );
X    pipe ( PREAD, CWRITE );
X
XFORK: {
X    if( $pid  = fork ) {
X	# do nothing here - this is the parent
X	# so subroutine should return.
X	close(STDIN);
X	close(STDOUT);		
X	select(PWRITE);
X	$| = 1;
X	select(STDOUT);
X    } elsif ( defined $pid ) {  
X	# child here.
X	close(PWRITE);
X	close(PREAD);
X
X	open( STDIN , "<&CREAD" ) || die "Can't redirect stdin.\n";
X	open( STDOUT, ">&CWRITE" ) || die "Can't redirect stdout.\n";
X
X	exec  'psh';
X    } elsif ( $! =~ /No more process/ ) {
X	# EAGAIN signal, pattern matched, recoverable
X	sleep 5;
X	redo FORK;
X    } else { 
X	# weird error - can't be handled
X	die "Can't fork: $!\n";
X    }
X}}
X
X
X# The PostScript Code
X# Comments stripped for faster execution.
X$GuiCode =  <<'%EOF';
X%! diskette tool stuff
X% PostScript mode
X
X/NeWS 3 0 findpackage beginpackage
X/TNTCore 3 0 findpackage beginpackage
X/TNT 3 0 findpackage beginpackage
X
X% Non-resizable window.
X% Should be centered
X% should contain an appropriate message and two
X% buttons - YES and NO
X/ClassDisketteWindow ClassBaseWindow [] classbegin
X    /Close? true def
X    /Footer? true def
X    /Label? true def
X    /Pin? false def
X    /Reshape? false def
X    
X    /QuitFromUser {
X	(quit\n) print
X	/QuitFromUser super send
X    } def
X
Xclassend def
X
X
X% Creations
X/DisketteWindow null framebuffer /new ClassDisketteWindow send def 
X(Diskette Tool) /setlabel DisketteWindow send
X0 10 8 10 /setgaps DisketteWindow send
X
X/sPanel /Calculated framebuffer /new ClassPanel send def
X[ /NorthWest 
X    { /South PREVIOUS POSITION       % x, y
X	exch dup		    	     % y
X	/Center PARENT POSITION  % y x y
X	pop exch		            % x y
X    }
X] /setlayoutparameters sPanel  send
X
X
X
X%/WarningLabel [ 
X%    (Are you absolutely sure you want to shutdown bialosky now?) 
X%    /lucidasans-bold findfont 18 scalefont 
X%]  framebuffer /new ClassLabel send def
X
X
X
X% file-system selection
X/fSelectors /Grid framebuffer /new ClassSettings send def
X/Exclusive /setchoicemode fSelectors send 
X[ (DOS Diskette) (Sun Diskette) ] /setitemlist fSelectors send
X[ false 1 2] /setlayoutparameters fSelectors send
X/Centered /setjustification fSelectors send
X
X
X% command buttons
X/Buttons /Spaced framebuffer /new ClassButtons send def
X[ 
X     [ (Mount) { 
X	 /Busy /setvisualstate DisketteWindow send
X	 (Mounting % on %.)  [  getModeString getTarget ] sprintf
X	 ()  /setfooter DisketteWindow send
X 	 (mount-%\n) [ getMode ] printf
X     } ]        % should ask perl to mount
X     [ (Eject) 	{ 
X	 /Busy /setvisualstate DisketteWindow send
X	 (eject\n) print 
X	 (Ejecting diskette) () /setfooter DisketteWindow send
X     } ]  % should ask perl to unmount/eject
X    [ (Format) { 
X	/Busy /setvisualstate DisketteWindow send 
X	(Formatting %.) [ getModeString  ] sprintf
X	() /setfooter  DisketteWindow send
X	(format-%\n) [ getMode ] printf
X    } ]  % should ask perl to format & mount.  
X] /setitemlist Buttons send
X
X0 /setdefault Buttons send
X/Centered /setjustification Buttons send
X35 8 /setgaps Buttons send
XDisketteWindow /settarget Buttons send
X
X
X/Center sPanel /addclient DisketteWindow send
X
X/fSelectors fSelectors [ /NorthWest
X    { /NorthWest PARENT POSITION 8 sub } ] /addclient sPanel send
X
X/Buttons Buttons [ /NorthWest
X    { /SouthWest PREVIOUS POSITION 10 sub
X
X    }
X] /addclient sPanel send
X
X
X% utility routines
X/Mode [ (DOS diskette) (Sun diskette) ] def
X/Target [ (/pcfs) (/mnt) ] def
X
X/getMode {
X    /value fSelectors send 0 get
X} def
X
X/getModeString { 
X    Mode getMode get
X} def
X
X/getTarget {
X    Target getMode get
X} def
X
X/unBusy { /Active /setvisualstate DisketteWindow send } def
X
X% takes a string argument.
X/perlLabel { () /setfooter DisketteWindow send } def
X
X% GoGo
X/place DisketteWindow send
X/new ClassEventMgr send /activate DisketteWindow send
X/map DisketteWindow send
X%EOF
X
X
Xsub checkMount {
X    local($flist);
X    $flist = `/etc/mount`;
X    $flist =~ m#/dev/fd0c#;
X}
X
Xsub mountDOS {
X    local($gooby);
X    $gooby = `/etc/mount -t pcfs /dev/fd0c /pcfs`;
X#    if ( $gooby == '' ) {
X#	print STDERR "Mount worked\n" ;
X#    } else { 
X#	print STDERR $gooby;
X#    }
X
X    $gooby == '';
X    
X}
X
X# I'm assuming that this subroutine will only be executed when
X# there is no disk mounted.
Xsub mountSUN {
X    local($gooby );
X     $gooby = `/etc/mount /dev/fd0c /mnt`;
X    $_ = `/etc/mount`;
X
X #   print STDERR $gooby;
X
X    if( m#/dev/fd0c# ) {
X       system( "/etc/chown", $ENV{ 'USER' } , "/mnt" );
X#	print STDERR "Mount worked\n" ;
X    } else { 
X#	print STDERR "Mount didn't work!\n"; 
X    }
X
X    $_ =~ m#/dev/fd0c#;
X
X}   
X    
X
X
X# Open a 2-way connection to the server
X&doForkStuff (  );
X
X# Dump PostScript code.
Xprint PWRITE $GuiCode;
X
Xwhile( <PREAD> ) {
X#    print STDERR $_;
X    if ( /(.*)quit(.*)/ ) {
X	# we should kill program.
X	die "floppy.pl stopping now.\n"
X    } elsif ( /(.*)format-0(.*)/ ) {
X	# print STDERR "Formatting DOS diskette\n";
X	
X	if ( &checkMount ) {
X	    print PWRITE "(Can't format mounted disk) perlLabel\n";
X	} else {
X	    if ( !system( "fdformat",  "-df" ) && 
X		print PWRITE "(Formatting DOS diskette) perlLabel\n" &&
X		&mountDOS ) {
X		print PWRITE "(Format finished.) perlLabel\n";
X	    } else {
X		print PWRITE "(Format failed.) perlLabel\n";
X	    }
X	}
X	print PWRITE "unBusy\n";
X    } elsif ( /(.*)format-1(.*)/) {
X	# print STDERR "Formatting SUN diskette\n";
X	
X	# checking if device is mounted.
X	if( &checkMount() ) {
X	    print PWRITE "(Can't format mounted disk) perlLabel\n";
X	} else {
X	    if( !system( "fdformat", "-f")  && 
X	       print PWRITE "(Making filesystem) perlLabel\n" &&
X	       !system( "/etc/newfs" , "/dev/rfd0c") && 
X	       &mountSUN ) {
X		   print PWRITE "(Format finished.) perlLabel\n";
X	       } else {
X		   print PWRITE "(Format failed.) perlLabel\n";
X	       }
X	}
X	print PWRITE "unBusy\n";
X    } elsif ( /(.*)mount-0(.*)/ ) {
X	# print STDERR "Mounting DOS diskette\n";
X
X	if( &checkMount() ){
X	    print PWRITE "(Already mounted.) perlLabel\n";
X	} else {
X	    #  print STDERR "Trying to mount\n";
X	    # print STDERR $>,"  ", $<, "\n";
X	    if ( &mountDOS  ) {
X		print PWRITE "(Mounted on /pcfs.) perlLabel\n";
X	    } else {
X		print PWRITE "(Couldn't mount.) perlLabel\n";
X	    }
X	}
X	print PWRITE "unBusy\n";
X    } elsif ( /(.*)mount-1(.*)/ ) {
X	# print STDERR "Mounting Sun diskette\n";
X
X	if( &checkMount() ) {
X	    print PWRITE "(Already mounted.) perlLabel\n";
X	} else {
X	    if ( &mountSUN ) {
X		print PWRITE "(Mounted on /mnt.) perlLabel\n";
X	    } else {
X		print PWRITE "(Couldn't mount.) perlLabel\n";
X	    }
X	}
X	print PWRITE "unBusy\n";
X    } elsif ( /(.*)eject(.*)/ ) {
X	# print STDERR "Ejecting diskette\n";
X
X	sub eject {
X	    if( system "eject" ) {
X		print PWRITE "(Eject failed) perlLabel\n";
X	    } else {
X		# Redundant some times.
X		system( "/etc/chown" , "root" , "/mnt" );
X		print PWRITE "(Disk ejected) perlLabel\n";
X		
X	    }
X	}
X	
X	if( &checkMount() ) {
X	    print PWRITE "(Unmounting disk) perlLabel\n";
X	    if( system "/etc/umount /dev/fd0c" ) {
X		print PWRITE "(Can't unmount busy filesystem.) perlLabel\n";
X	    } else {
X		&eject;
X	    }
X	} else {
X	    &eject;
X	}
X	print PWRITE "unBusy\n";
X    }
X}
X
X
X
END_OF_FILE
if test 7266 -ne `wc -c <'floppy.pl'`; then
    echo shar: \"'floppy.pl'\" unpacked with wrong size!
fi
chmod +x 'floppy.pl'
# end of 'floppy.pl'
fi
if test -f 'shutdown' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'shutdown'\"
else
echo shar: Extracting \"'shutdown'\" \(3126 characters\)
sed "s/^X//" >'shutdown' <<'END_OF_FILE'
X#!/usr/local/bin/taintperl
X# a perl script
X# Copyright 1992, Robert Kroeger
X
X# Program modified for better security
X$ENV{'PATH'} = '/bin:/usr/bin:/usr/etc:/usr/etc/bin:/usr/openwin/bin';
X
Xsub doForkStuff {
X    pipe ( CREAD, PWRITE );
X    pipe ( PREAD, CWRITE );
X
XFORK: {
X    if( $pid  = fork ) {
X	# do nothing here - this is the parent
X	# so subroutine should return.
X	close(STDIN);
X	close(STDOUT);		
X    } elsif ( defined $pid ) {  
X	# child here.
X	close(PWRITE);
X	close(PREAD);
X
X	open( STDIN , "<&CREAD" ) || die "Can't redirect stdin.\n";
X	open( STDOUT, ">&CWRITE" ) || die "Can't redirect stdout.\n";
X
X	exec  'psh';
X    } elsif ( $! =~ /No more process/ ) {
X	# EAGAIN signal, pattern matched, recoverable
X	sleep 5;
X	redo FORK;
X    } else { 
X	# weird error - can't be handled
X	die "Can't fork: $!\n";
X    }
X}}
X
X
X# The PostScript Code
X# Comments stripped for faster execution.
X$GuiCode =  <<'%EOF';
X/NeWS 3 0 findpackage beginpackage
X/TNTCore 3 0 findpackage beginpackage
X/TNT 3 0 findpackage beginpackage
X
X/ClassShutdownWindow ClassBaseWindow [] classbegin
X    /Close? false def
X    /Footer? true def
X    /Label? true def
X    /Pin? false def
X    /Reshape? false def
X
X    /QuitFromUser {
X	(QU\n) print
X        /QuitFromUser super send
X	} def
Xclassend def
X
X% Creations
X/ShutdownWindow null framebuffer /new ClassShutdownWindow send def 
X(Shutdown Tool) /setlabel ShutdownWindow send
X
X/sPanel /Calculated framebuffer /new ClassPanel send def
X[ /NorthWest 
X    { /South PREVIOUS POSITION       % x, y
X	exch dup		    	     % y
X	/Center PARENT POSITION  % y x y
X	pop exch		            % x y
X    }
X] /setlayoutparameters sPanel  send
X
X/WarningLabel [ 
X    (Are you absolutely sure you want to shutdown bialosky now?) 
X    /lucidasans-bold findfont 18 scalefont 
X]  framebuffer /new ClassLabel send def
X
X% YES/NO button grouping
X/Buttons /Spaced framebuffer /new ClassButtons send def
X[ 
X     [ (YES) 
X 	{ 
X		(SD\n) print 
X		(Bialosky shutting down now.) () /setfooter ShutdownWindow send
X	} ]        % should indicate shutdown
X     [ (NO) { 
X	(QU\n) print
X	/ShutdownWindow null def
X     } ]  % should kill window
X] /setitemlist Buttons send
X
X1 /setdefault Buttons send
X/Centered /setjustification Buttons send
X40 8 /setgaps Buttons send
XShutdownWindow /settarget Buttons send
X
X/Center sPanel /addclient ShutdownWindow send
X/WarningLabel WarningLabel [ /NorthWest { /NorthWest PARENT POSITION } ]    
X                     /addclient sPanel send
X/Buttons Buttons [ /NorthWest
X    { /South PREVIOUS POSITION 10 sub
X	exch
X	CURRENT WIDTH 2 div sub
X	exch
X    }
X] /addclient sPanel send
X
X% GoGo
X/place ShutdownWindow send
X/new ClassEventMgr send /activate ShutdownWindow send
X/map ShutdownWindow send
X%EOF
X
X# Open a 2-way connection to the server
X&doForkStuff (  );
X
X# Dump PostScript code.
Xprint PWRITE $GuiCode;
X
Xwhile( <PREAD> ) {
X	# print STDERR $_;
X	if ( /(.*)SD(.*)/ ) {
X		# we should shutdown the system.
X		# should we check if some-one else is on? - no.
X		#print STDERR "Should shut down NOW\n" ;
X		# Do something that only root can do.
X		exec  "/usr/etc/shutdown -h now";
X	} else {
X	    die "Not shutting down now.\n";
X	}
X}
X
X
X
X
END_OF_FILE
if test 3126 -ne `wc -c <'shutdown'`; then
    echo shar: \"'shutdown'\" unpacked with wrong size!
fi
chmod +x 'shutdown'
# end of 'shutdown'
fi
echo shar: End of shell archive.
exit 0