Subject: Term Queued Upload 0.1
From: [email-masked] (Nicholas Vargish)
Date: 5 May 1993 12:14:35 +0300
Newsgroups: comp.os.linux.announce

Here's my first attempt at a queued upload package for term users...
Enjoy!

Nick

CUT HERE---------------------------------------------------------CUT HERE
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 05/05/1993 03:48 UTC by [email-masked]
# Source directory /nfs/homes/noc/vargish/Bin/Perl
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   5071 -rw------- README.tup
#   4221 -rw------- tupd
#    624 -rw------- tupq
#   2071 -rw------- tup
#
# ============= README.tup ==============
if test -f 'README.tup' -a X"$1" != X"-c"; then
	echo 'x - skipping README.tup (File already exists)'
else
echo 'x - extracting README.tup (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README.tup' &&
X
X
README FOR TUP 0.1 
X
May 4, 1993
Nick Vargish ([email-masked])
X
0. INTRODUCTION
X
A few days ago I posted a suggestion for a term client that would
spool files for upload. This was because (1) I wanted to ensure that
only one file transfer was in progress in either direction --
bandwidth is scarce enough, and (2) So I could "flag" files for upload
when my term connection was not up.
X
After letting the idea ferment for a little while, and after looking
over the mail I received (one of which was, in sum, "I don't run Linux
and I have never heard of term, but why don't you use SLIP?" :^), I
hacked together the following:
X
TUP 0.1 "Proof of Concept Version"
X
1. CONTENTS
X
There are three Perl programs in the package:
X
X	tupd -- the daemon that actually handles uploading items in
X		the upload queue. Invocation is simple; just type
X		"tupd". You can spool files without the daemon being
X		active, and they will be sent when the daemon is
X		started.
X
X	tup  -- the spooling program. Use this to send files to the
X		upload queue, "tup filename". If the filename does not
X		start with a slash, it is assumed to be located
X		relative to the current directory. Multiple files can
X		be specified.
X
X	tupq -- displays the item being uploaded and the items waiting
X		in the queue. Invoke it with no arguments, "tupq".
X
2. FEATURES
X
Very few. :^)
X
Tup actually does a couple of cool things: it has a simple file-
locking mechanism built in (there are some problems with flock(),
especially for those with networked directories, and some poeple just
plain don't have it).
X
If the daemon (tupd) gets killed while in the middle of a transfer,
the transfer should be resumed when the daemon is restarted. I have
not determined if this works properly if the tupload process that
actually handles the transfer gets hosed.
X
3. CAVEATS, COMMENTS, AND THOUGHTS
X
This is a "proof of concept" version -- it works, it won't break
anything seriously (I hope!), and it shows that the approach is
feasible. However, this is a very basic package, and there are a few
features missing that are essential to a fully functioning spooling
package.
X
Mainly, the queue manipulation is lacking (nearly non-existent).
As of 0.1, there is no way to remove an item from the queue (fairly
easy -- I expect to have that done sometime tomorrow). There is no way
to move items ahead in the queue or kill the current job. There is
no... you get the point.
X
Related to the lack of queue manipulation tools is a certain
ambivalence on my part regarding job ids. The package is set up to
allow job ids, and refers to them in the log file... unfortunately, I
have not yet implemented a "job id generator" since I can't decide if
they will actually be useful. This isn't a print queue, after all,
where you may _want_ several drafts of the same file; why should I
put in the effort to further "uniqueify" each entry? I suspect that a
better solution is for tup to refuse to add to the queue a file name
that is already on the list for uploading... perhaps instead of a job
id, I will include a file size in the queue entry...
X
Although tupd uses tupload to send files, tup ignores any non-file
arguments. This means that you cannot do "tup myfile -as overthere".
I plan to introduce arguments to tup (and thus to tupload) in the next
version, or the one after that, but for now the functionality is very
vanilla.
X
I made an implementation decision not to copy the files into a spool
directory. Instead of adding _files_ to the queue, file _names_ are
added to a list. Thus, you can't "tup file.tar.z ; rm file.tar.z".
Sorry, but a lot of the files I upload are fairly large -- I have no
desire to duplicate those files on my already sparse hard-drive...  On
the other hand, tupd will skip any queue entries that it can no longer
find a file for (tup will _not_ add non-existent files to the queue,
but they may get deleted between being added to the queue and when
tupd gets to them).
X
Occasionally tupd will seem to be refusing to send anything, even
though there is a term connection, and the files exist locally. This
can happen if tupd or tup get killed in the middle of working with a
data file. Odds are good that if you "rm $HOME/.term/*.lock"
everything will return to normal -- you shouldn't even have to restart
tupd. there's a chance that the data files have been corrupted, but I
have yet to see this happen. I am trying to decide if allowing tupd to
unlink the lock files at startup is a REALLY BAD idea or just a bad
idea.
X
Tupd should refuse to start if there is already a tupd running; I
haven't really investigated what happens if you try to start more than
one tupd...
X 
Keep an eye on the log files, tup.log and tupload.out, since they have
the potential ability to grow without limit...
X
4. IN CLOSING...
X
...you can see that there is much to do on this program. If you have
any comments, questions, or suggestions, please feel free to send me
e-mail. If you have any enhancements or fixes to make to the tup
package, I will be very grateful...
X
Nick ([email-masked])
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
SHAR_EOF
chmod 0600 README.tup ||
echo 'restore of README.tup failed'
Wc_c="`wc -c < 'README.tup'`"
test 5071 -eq "$Wc_c" ||
	echo 'README.tup: original size 5071, current size' "$Wc_c"
fi
# ============= tupd ==============
if test -f 'tupd' -a X"$1" != X"-c"; then
	echo 'x - skipping tupd (File already exists)'
else
echo 'x - extracting tupd (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tupd' &&
#!/usr/bin/perl
X
# tupd -- tupload queue daemon
#	v.0.1 "proof of concept" (May 4, 1993)
#	Nick Vargish ([email-masked])
X
# filenames
$termdir	= $ENV{'HOME'} . '/.term/';
$tupqfile	= $termdir . 'tup.queue';
$currentjob	= $termdir . 'tup.current';
$logfile	= $termdir . 'tup.log';
$tuploadlog	= $termdir . 'tupload.out';
X
# global variables
$pollinterval	= 10;	# poll queue every n seconds
$goddessisgood	= 1;	# true constant
X
# start logging this session
&log ("tupd: starting daemon\n");
X
# if there is a current job file, then the last transfer was interrupted...
# add the interrupted job back to the queue:
if (-e $currentjob) {
X   &ezlock ($tupqfile); open (TUPQ, "$tupqfile");
X   &ezlock ($currentjob); open (CURRENT, "$currentjob");
X   @joblist = <TUPQ>;
X   unshift (@joblist, <CURRENT>);
X   close TUPQ; close CURRENT; unlink $currentjob; unlink $tupqfile;
X   open (TUPQ, "> $tupqfile");
X   print TUPQ @joblist;
X   close TUPQ;
}
X
# start the queueing daemon. the double-fork technique is stolen shamelessly
# from p.216 of the _Perl_ book by Larry Wall and Randal Schwartz.
unless (fork) {
X   unless (fork) {
X      sleep 1 until getppid == 1;	# wait until we become a daemon
X
X      # the main body of the daemon is very simple. essentially, it waits
X      # until the queue file is non-zero. 
X      while ($goddessisgood) {
X         sleep $pollinterval until -s $tupqfile;	# wait for queue
X         &doqitem ();					# do an item from queue
X      }
X
X      # theoretically, we never get here.
X      &log ("tupd: daemon finishing\n");
X      exit 0;
X   } 
X   exit 0;
}
wait; exit 0;
X
# &doqitem ()
# this routine actually sends the job. currently, the mechanism for sending
# a file is to send the job to tupload; this means that each job must be
# the arguments for a tupload invocation.
X
sub doqitem {
X   local ($job) = &getnextjob ();
X   $job =~ /^(.+)\t(.+)$/;	
X   local ($jobid) = $1;		# extract the jobid and the actual job from 
X   local ($jobargs) = $2;	# the queue information.
X
X   # throw away this job if the file can't be found
X   if (!(-e $jobargs)) {
X	   &log ("tupd: couldn't find file $jobargs, skipping.\n"); 
X           return 0; 
X   }
X
X   # add a line to the log and create a file that describes the current job
X   # (in case the transfer gets hosed, tupd should requeue the file...)
X   &log ("tupd: starting job $jobid as (tupload $jobargs)\n");
X   &ezlock ($currentjob); open (CURRENT, "> $currentjob")
X	|| die "tupd: can't open current job description file $currentjob.\n";
X   print CURRENT $job;
X   close CURRENT; &ezunlock ($currentjob);
X
X   # do the actual uploading
X   system ("tupload -v $jobargs >>$tuploadlog 2>>$tuploadlog");
X   die "tupd: abnormal return ($?) from (tupload $jobargs).\n" if $?;
X
X   # log the completed upload and remove the job description file.
X   &log ("tupd: finished job $jobid (tupload $jobargs)\n");
X   &ezlock ($currentjob); unlink $currentjob; &ezunlock ($currentjob);
}
X
# &getnextjob ()
# this routine reads the first line from the queue file. then it writes
# the rest of the lines back to the queue file. it returns the first line
# of the queue file and does simple file locking...
X
sub getnextjob {
X   &ezlock ($tupqfile); open (TUPQ, $tupqfile)
X			|| die "tupd: can't open queue file $tupqfile.\n";
X   local (@jobs) = <TUPQ>;
X   local ($job) = shift(@jobs);
X   close TUPQ; unlink $tupqfile;
X   open (TUPQ, "> $tupqfile")
X			|| die "tupd: can't open queue file $tupqfile.\n";
X   print TUPQ @jobs;
X   close TUPQ;
X   &ezunlock ($tupqfile);
X   $nextjob = $job;
}
X
# &log (log file comment)
# writes a comment to the log file.
X
sub log {
X   open (LOG, ">> $logfile") || die "tupq: can't open log $logfile\n";
X   print LOG $_[0];
X   close LOG;
}
X
# &ezlock (filename)
# &ezunlock (fileneme)
# use these commands to lock and unlock a file. all routines that wish
# to participate in in this locking must call "&ezlock (filename)" before
# doing operations that will alter the file. these routines are provided as
# not all systems support the flock() system call.
X
sub ezlock {
X   local ($thelock) = $_[0] . '.lock';
X   sleep 1 while -e $thelock;
X   system "touch $thelock";
}
sub ezunlock {
X   local ($thelock) = $_[0] . '.lock';
X   unlink $thelock;
}
X   
X
X
X
SHAR_EOF
chmod 0600 tupd ||
echo 'restore of tupd failed'
Wc_c="`wc -c < 'tupd'`"
test 4221 -eq "$Wc_c" ||
	echo 'tupd: original size 4221, current size' "$Wc_c"
fi
# ============= tupq ==============
if test -f 'tupq' -a X"$1" != X"-c"; then
	echo 'x - skipping tupq (File already exists)'
else
echo 'x - extracting tupq (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tupq' &&
#!/usr/bin/perl
X
# tupq -- tupload queue display
#	v.0.1 "proof of concept" (May 4, 1993)
#	Nick Vargish ([email-masked])
X
# filenames
$termdir	= $ENV{'HOME'} . '/.term/';
$tupqfile	= $termdir . 'tup.queue';
$currentjob	= $termdir . 'tup.current';
X
if (-e $currentjob) {
X   open (CURRENT, $currentjob);
X   $current = <CURRENT>; 
X   close CURRENT; }
else
X   { $current = "no current job\n"; }
print "Currently uploading:\n\t$current";
X
print "Jobs on queue:\n";
if (-s $tupqfile) {
X   open (TUPQ, $tupqfile);
X   while (<TUPQ>) 
X      { print "\t$_"; }
X   close (TUPQ);
}
else
X   { print "\tno jobs on queue\n"; }
X
Xexit 0;
X
SHAR_EOF
chmod 0600 tupq ||
echo 'restore of tupq failed'
Wc_c="`wc -c < 'tupq'`"
test 624 -eq "$Wc_c" ||
	echo 'tupq: original size 624, current size' "$Wc_c"
fi
# ============= tup ==============
if test -f 'tup' -a X"$1" != X"-c"; then
	echo 'x - skipping tup (File already exists)'
else
echo 'x - extracting tup (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tup' &&
#!/usr/bin/perl
X
# tup -- tupload queue spooler
#	v.0.1 "proof of concept" (May 4, 1993)
#	Nick Vargish ([email-masked])
X
# filenames
$termdir	= $ENV{'HOME'} . '/.term/';
$tupqfile	= $termdir . 'tup.queue';
$logfile	= $termdir . 'tup.log';
X
$thepath = $ENV{'PWD'} . '/';		# current directory
X
while (@ARGV) {
X
X   $thearg = shift;
X
X   # it's terrible, but since this is a proof-of-concept, we are just
X   # going to skip all non-file arguments...
X
X   next unless -e $thearg;   
X
X   # if the arg doesn't start with a slash, we assume it is a filename
X   # relative to the current path
X
X   if ($thearg =~ /^\//)
X      { $thefile = $thearg; }
X   else
X      { $thefile = $thepath . $thearg; }
X
X   # create a queue entry
X
X   $thejob = &getjobid() . "\t" . $thefile . "\n";
X   print "tup: adding $thefile to upload queue.\n";
X   &addtoq ($thejob);
}
Xexit 0;
X
X
# &addtoq (job)
# adds job to the upload queue. does simple file locking.
X
sub addtoq {
X   local ($thejob) = $_[0];
X   &log ("tup: adding to queue: $thejob");
X   &ezlock ($tupqfile); open (TUPQ, ">> $tupqfile")
X	   		|| die ("tup: can't open queue file $tupqfile.\n");
X   print TUPQ $thejob;
X   close TUPQ;
X   &ezunlock ($tupqfile);
}
X
# &getjobid ()
# this will assign a unique id to the job. since i have not yet implemented
# de-queueing, the id is not important yet...
X
sub getjobid {
X   local ($jobid) = 666;
}
X
# &log (log file comment)
# writes a comment to the log file.
X
sub log {
X   open (LOG, ">> $logfile") || die "tupq: can't open log $logfile\n";
X   print LOG $_[0];
X   close LOG;
}
X
# &ezlock (filename)
# &ezunlock (fileneme)
# use these commands to lock and unlock a file. all routines that wish
# to participate in in this locking must call "&ezlock (filename)" before
# doing operations that will alter the file. these routines are provided as
# not all systems support the flock() system call.
X
sub ezlock {
X   local ($thelock) = $_[0] . '.lock';
X   sleep 1 while -e $thelock;
X   system "touch $thelock";
}
sub ezunlock {
X   local ($thelock) = $_[0] . '.lock';
X   unlink $thelock;
}
X   
X
X
X
X
X
X
X
X
X
SHAR_EOF
chmod 0600 tup ||
echo 'restore of tup failed'
Wc_c="`wc -c < 'tup'`"
test 2071 -eq "$Wc_c" ||
	echo 'tup: original size 2071, current size' "$Wc_c"
fi
exit 0
-- 
|  Nick Vargish       |
|  SURAnet Operations |   Who needs a fancy .signature when I have all this?
|  [email-masked]   |