diff options
Diffstat (limited to 'ipl/progs/mszip.icn')
| -rw-r--r-- | ipl/progs/mszip.icn | 361 |
1 files changed, 361 insertions, 0 deletions
diff --git a/ipl/progs/mszip.icn b/ipl/progs/mszip.icn new file mode 100644 index 0000000..2e6744a --- /dev/null +++ b/ipl/progs/mszip.icn @@ -0,0 +1,361 @@ +############################################################################ +# +# File: mszip.icn +# +# Subject: Program to ZIP a directory for MS-DOS use +# +# Author: Gregg M. Townsend +# +# Date: June 23, 2000 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# usage: mszip [options] root-directory zip-file +# -n no action: just report; zip-file may be omitted +# -v verbose commentary: list individual file types +# -i check filenames for ISO 9660 (CD-ROM) legality +# +# Mszip stuffs the contents of a directory into a ZIP archive file, +# translating text files to CRLF form. Pipes are opened that +# require find, sort, and zip in the search path. +# +# The default report gives an inventory of files by extension. This +# can be useful even without creating a ZIP file ("mszip -n dir"). +# +# File types on the verbose report are: +# x unreadable file +# e empty file +# b binary file +# c text file with CRLFs +# n text file with newlines +# A file is "binary" if it contains more than 1% unexpected characters. +# +# Symlinks, FIFOs, device files etc. are reported and not archived. +# Files with illegal MS-DOS names are reported but still archived. +# +############################################################################ +# +# Requires: UNIX, zip program +# +############################################################################ + + + +$define USAGE "[-n] [-v] [-i] root-directory zip-file" + +$define BTHRESH 0.01 # allowed fraction of wild bytes in text file + +$define BUFSIZ 65536 # size of buffer for checking binary/text + # (bytes beyond this many are not checked) + +$define ZIPOPTS "-9 -X" # best compression; omit uid/gid + + +link options + + + +global verbose +global errorcount +global allfiles, binlist, txtlist +global extns + + + +procedure main(args) + local opts, root, zipopts, zipname + local pwd, pipe, fname, errmsg + local nmproc + + # process options + opts := options(args, "nvi") + verbose := opts["v"] + if \opts["i"] then + nmproc := isoname + else + nmproc := msname + + root := args[1] | stop("usage: ", &progname, " ", USAGE) + + # get current directory name and prepend to zip file if necessary + if /opts["n"] then { + zipname := args[2] | stop("usage: ", &progname, USAGE) + pipe := popen("pwd") + pwd := read(pipe) | stop("can't read current directory") + close(pipe) + if not zipname ? ="/" then + zipname := pwd || "/" || zipname + } + + # change to source directory + chdir(root) | stop("can't change to directory: ", root) + + # verify that zip file is writable + if \zipname then { + if not close(open(zipname, "w")) then + stop(zipname, ": cannot write") + remove(zipname) + } + + # initialize + errorcount := 0 + extns := table("") + allfiles := [] + binlist := [] + txtlist := [] + + # check for "bad" files: symlinks, fifos, etc. + write(&errout, "finding files...") + pipe := popen("find . ! -type d ! -type f -print | sort") + while report(read(pipe), "bad file type") + close(pipe) + + # get list of the rest + pipe := popen("find . -type f -print | sort") + while fname := read(pipe) do { + put(allfiles, fname) + if not nmproc(fname) then + report(fname, "illegal filename") + } + close(pipe) + + # inspect files + write(&errout, "inspecting files...") + while inspect(get(allfiles)) + + # summarize file types by extension + summary() + + # write zip file, if -n was not specified + if \zipname then { + + zipopts := ZIPOPTS + if /verbose then + zipopts := ZIPOPTS || " -q" + + # create zip file and fill with text files + write(&errout, "storing text files...") + pipe := popen("zip -l " || zipopts || " " || zipname || " -@", "w") + every write(pipe, !txtlist) + close(pipe) + + # add binary files to zip file + write() + write(&errout, "storing binary files...") + pipe := popen("zip -g " || zipopts || " " || zipname || " -@", "w") + every write(pipe, !binlist) + close(pipe) + } + + # exit + if errorcount > 0 then + stop("\t", errorcount, " error(s)") + else + write("done.") +end + + + +# popen(cmd, mode) -- open pipe, and abort on error + +procedure popen(cmd, mode) + local f + + mode := "p" || (\mode | "r") + f := open(cmd, mode) | stop("can't open pipe: ", cmd) + return f +end + + + +# census(s, c, lim) -- count occurrences of members of c in string s +# +# If lim is given, counting can stop early. + +procedure census(s, c, lim) + local n + + /lim := *s + n := 0 + s ? { + while n < lim & tab(upto(c)) do + n +:= *tab(many(c)) + } + n >:= lim + return n +end + + + +# msname(fname) -- check filename for MS-DOS legality + +procedure msname(fname) + local dir, base, ext + static forbid + initial forbid := &cset -- &letters -- &digits -- '/._^$~!#%&-{}()@\'`' + + fname ? { + if upto(forbid) then fail # forbidden char + while dir := tab(upto('/') + 1) do + if *dir > 9 then fail # dir component too long + if base := tab(upto('.')) then { + move(1) + if upto('.') then fail # two periods + ext := tab(0) + } + else { + base := tab(0) + ext := "" + } + if (*base > 8) | (*ext > 3) then fail # component too long + } + return +end + + + +# isoname(fname) -- check for ISO-9660 (CD-ROM) filename legality +# +# (disallows explicit version numbers) + +procedure isoname(fname) + static legal + initial legal := &lcase ++ &ucase ++ &digits ++ '_.' + + fname ? { + while tab(upto('/') + 1) + tab(many(legal)) + if pos(0) then + return msname(fname) + else + fail + } +end + + + +# inspect(fname) -- inspect one file and update lists + +procedure inspect(fname) + local c + + fname ? { + if ="./" then + fname := tab(0) + } + + c := ftype(fname) + count(fname, c) + if \verbose then write(c, " ", fname) + + if c == "x" then { + report(fname, "unreadable file") + return + } + + if c == "n" then + put(txtlist, fname) + else + put(binlist, fname) + + return +end + + + +# ftype(fname) -- return file type character + +procedure ftype(fname) + local f, s, lim + static bset + initial bset := # allows \a\b\t\n\v\f\r\^Z + '\0\1\2\3\4\5\6\16\17\20\21\22\23\24\25\26\27\30\31\33\34\35\36\37' ++ + &cset[128+:33] + + f := open(fname, "ru") | return "x" + s := reads(f, BUFSIZ) + close(f) + + if /s | (*s = 0) then return "e" + lim := BTHRESH * *s + if census(s, bset, lim) >= lim then return "b" + else if census(s, '\l') > census(s, '\r') then return "n" + else return "c" +end + + + +# count(fname, typechar) -- count file extension + +procedure count(fname, tchar) + local extn + + fname ? { + while tab(upto('/') + 1) + if tab(upto('.') + 1) then { + while tab(upto('.') + 1) + extn := tab(0) + } + else + extn := "" + } + extns[extn] ||:= tchar + return +end + + + +# report(fname, errmsg) -- report error + +procedure report(fname, errmsg) + write(&errout, "\t", errmsg, ": ", fname) + errorcount +:= 1 + return +end + + + +# summary() -- generate summary of extension counts + +procedure summary() + local tlist, ext, s, b, c, e, n, x, tb, tc, te, tn, tx + + write() + write(" unrd empty bin crlf newln extension") + tb := tc := te := tn := tx := 0 + + tlist := sort(extns, 3) + while ext := get(tlist) do { + s := get(tlist) + tb +:= (b := census(s, 'b')) + tc +:= (c := census(s, 'c')) + te +:= (e := census(s, 'e')) + tn +:= (n := census(s, 'n')) + tx +:= (x := census(s, 'x')) + write(r5(x), r5(e), r5(b), r5(c), r5(n), " .", ext) + } + + write() + write(r5(tx), r5(te), r5(tb), r5(tc), r5(tn), " TOTAL: ", tx+te+tb+tc+tn) + write() + return +end + + + +# r5(n) -- show integer in 5-char field, if nonzero + +procedure r5(n) + local s + + if n = 0 then return " " + s := integer(n) + if *s < 5 then + return right(s, 5) + else + return " " || s +end |