home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 2 / 2733 / iidecode.icn next >
Encoding:
Text File  |  1991-02-10  |  6.0 KB  |  248 lines
  1. ############################################################################
  2. #
  3. #    Name:     iidecode.icn
  4. #
  5. #    Title:     iidecode (port of the Unix/C uudecode program to Icon)
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Version: 1.7
  10. #
  11. ############################################################################
  12. #
  13. #  This is an Icon port of the Unix/C uudecode utility.  Since
  14. #  uudecode is publicly distributable BSD code, I simply grabbed a
  15. #  copy, and rewrote it in Icon.  The only basic functional changes I
  16. #  made to the program were:  1) To simplify the notion of file mode
  17. #  (everything is encoded with 0644 permissions), and 2) to add a
  18. #  command-line switch for xxencoded files (similar to uuencoded
  19. #  files, but capable of passing unscathed through non-ASCII EBCDIC
  20. #  sites).
  21. #
  22. #         usage:  iidecode [infile] [-x]
  23. #
  24. #  Usage is compatible with that of the UNIX uudecode command, i.e. a
  25. #  first (optional) argument gives the name the file to be decoded.
  26. #  If this is omitted, iidecode just uses the standard input.  The -x
  27. #  switch (peculiar to iidecode) forces use of the the xxdecoding
  28. #  algorithm.  If you try to decode an xxencoded file without speci-
  29. #  -x on the command line, iidecode will try to forge ahead anyway.
  30. #  If it thinks you've made a mistake, iidecode will inform you after
  31. #  the decode is finished.
  32. #
  33. #  BUGS:  Slow.  I decided to go for clarity and symmetry, rather than
  34. #  speed, and so opted to do things like use ishift(i,j) instead of
  35. #  straight multiplication (which under Icon v8 is much faster).
  36. #
  37. ############################################################################
  38. #
  39. #  See also: iiencode.icn
  40. #
  41. ############################################################################
  42.  
  43.  
  44. global oversizes
  45.  
  46. procedure main(a)
  47.  
  48.     local ARG, in, out, dest, is_xx
  49.  
  50.     # Check for correct number of args.
  51.     if *a > 2 then {
  52.     write(&errout,"usage:  iidecode [infile] [-x]")
  53.     exit (2)
  54.     }
  55.  
  56.     # Check for optional input filename and -x
  57.     every ARG := !a do {
  58.     if ARG == "-x" then
  59.         is_xx := 1
  60.     else {
  61.         if not (in := open(ARG, "r")) then {
  62.         write(&errout,"Can't open input file, ",a[1],".")
  63.         write(&errout,"usage:  iidecode [infile] [-x]")
  64.         exit(1)
  65.         }
  66.     }
  67.     }
  68.     /in := &input
  69.  
  70.     # Find the "begin" line, and determine the destination file name.
  71.     !in ? {
  72.     tab(match("begin ")) &
  73.     tab(many(&digits))   &    # mode ignored
  74.     tab(many(' '))       &
  75.     dest := trim(tab(0),'\r') # concession to MS-DOS
  76.     }
  77.  
  78.     # If dest is null, the begin line either isn't present, or is
  79.     # corrupt (which necessitates our aborting with an error msg.).
  80.     if /dest then {
  81.     write(&errout,"No begin line.")
  82.     exit(3)
  83.     }
  84.  
  85.     # Tilde expansion is heavily Unix dependent, and we can't always
  86.     # safely write the file to the current directory.  Our only choice
  87.     # is to abort.
  88.     if match("~",dest) then {
  89.     write(&errout,"Please remove ~ from input file begin line.")
  90.     exit(4)
  91.     }
  92.        
  93.     out := open(dest, "wu")
  94.     decode(in, out, is_xx)    # decode checks for "end" line
  95.     if not match("end", !in) then {
  96.     write(&errout,"No end line.\n")
  97.     exit(5)
  98.     }
  99.  
  100.     # Check global variable oversizes (set by DEC) to see if we used the
  101.     # correct decoding algorithm.
  102.     if \is_xx then {
  103.     if oversizes = 0 then {
  104.         write(&errout, "Input file appears to have been uuencoded.")
  105.         write(&errout, "Try invoking iidecode without the -x arg.")
  106.     }
  107.     }
  108.     else {
  109.     if oversizes > 1 then {
  110.         write(&errout, "Input file is either corrupt, or xxencoded.")
  111.         write(&errout, "Please check the output; try the -x option.")
  112.     }
  113.     }
  114.  
  115.     every close(\in | out)
  116.  
  117.     exit(0)
  118.  
  119. end
  120.  
  121.  
  122.  
  123. procedure decode(in, out, is_xx)
  124.     
  125.     # Copy from in to out, decoding as you go along.
  126.  
  127.     local line, chunk
  128.  
  129.     if \is_xx then
  130.     DEC := xxDEC
  131.  
  132.     while line := read(in) do {
  133.  
  134.     if *line = 0 then {
  135.         write(&errout,"Short file.\n")
  136.         exit(10)
  137.     }
  138.  
  139.     line ? {
  140.         n := DEC(ord(move(1)))
  141.  
  142.         if not ((*line-1) % 4 = 0, n <= ((*line / 4)*3)) then {
  143.         write(&errout,"Short and/or corrupt line:\n",line)
  144.         if /is_xx & oversizes > 1 then
  145.             write(&errout,"Try -x option?")
  146.                 exit(15)
  147.             }
  148.  
  149.         # Uuencode signals the end of the coded text by a space
  150.         # and a line (i.e. a zero-length line, coded as a space).
  151.         if n <= 0 then break
  152.         
  153.         while (n > 0) do {
  154.         chunk := move(4) | tab(0)
  155.         outdec(chunk, out, n)
  156.         n -:= 3
  157.         }
  158.     }
  159.     }
  160.     
  161.     return
  162.  
  163. end
  164.  
  165.  
  166.  
  167. procedure outdec(s, f, n)
  168.  
  169.     # Output a group of 3 bytes (4 input characters).  N is used to
  170.     # tell us not to output all of the chars at the end of the file.
  171.  
  172.     local c1, c2, c3
  173.  
  174.     c1 := iand(
  175.            ior(
  176.            ishift(DEC(ord(s[1])),+2),
  177.            ishift(DEC(ord(s[2])),-4)
  178.            ),
  179.            8r0377)
  180.     c2 := iand(
  181.            ior(
  182.            ishift(DEC(ord(s[2])),+4),
  183.            ishift(DEC(ord(s[3])),-2)
  184.            ),
  185.            8r0377)
  186.     c3 := iand(
  187.            ior(
  188.            ishift(DEC(ord(s[3])),+6),
  189.            DEC(ord(s[4]))
  190.            ),
  191.            8r0377)
  192.  
  193.     if (n >= 1) then
  194.     writes(f,char(c1))
  195.     if (n >= 2) then
  196.     writes(f,char(c2))
  197.     if (n >= 3) then
  198.     writes(f,char(c3))
  199.  
  200. end    
  201.  
  202.  
  203.  
  204. procedure DEC(c)
  205.  
  206.     # global oversizes
  207.     initial oversizes := 0
  208.  
  209.     # Count characters lexically greater or equal to 'a.'
  210.     # If we get a lot of these, the file is corrupt, or perhaps
  211.     # xxencoded (in which case -x should have been specified).
  212.     if c >= 97 then
  213.     oversizes +:= 1
  214.  
  215.     # Subtract 32 and mask off seventh and higher bits.
  216.     return iand(c - 32, 8r077)
  217.  
  218. end
  219.  
  220.  
  221.  
  222. procedure xxDEC(c)
  223.  
  224.     local k, ordval
  225.     static ordtbl
  226.     # global oversizes
  227.     initial {
  228.     ordval := -1
  229.     ordtbl := table()
  230.     every k := ord(!"+-0123456789ABCDEFGHIJKLMNOPQRST_
  231.                  UVWXYZabcdefghijklmnopqrstuvwxyz")
  232.     do insert(ordtbl, k, ordval +:= 1)
  233.     oversizes := 0
  234.     }
  235.  
  236.     # Mask off eighth and higher bits.
  237.     new_c := iand(c, 8r177)
  238.  
  239.     # Count characters lexically greater or equal to 'a.'
  240.     # If we find none of these, the file probably wasn't xxencoded.
  241.     if new_c >= 97 then
  242.     oversizes +:= 1
  243.  
  244.     # Map to 0-63 range (00111111 or less), mask off extra bits.
  245.     return iand(ordtbl[new_c], 8r077)
  246.  
  247. end
  248.