ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.48
Committed: Fri Feb 28 17:19:02 2020 UTC (4 years, 2 months ago) by root
Branch: MAIN
Changes since 1.47: +24 -13 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 package Convert::UUlib;
2    
3 root 1.28 no warnings;
4     use strict;
5    
6 root 1.1 use Carp;
7    
8     require Exporter;
9     require DynaLoader;
10    
11 root 1.44 our $VERSION = 1.62;
12 root 1.1
13 root 1.28 our @ISA = qw(Exporter DynaLoader);
14 root 1.1
15 root 1.28 our @_consts = qw(
16 root 1.1 ACT_COPYING ACT_DECODING ACT_ENCODING ACT_IDLE ACT_SCANNING
17    
18     FILE_DECODED FILE_ERROR FILE_MISPART FILE_NOBEGIN FILE_NODATA
19     FILE_NOEND FILE_OK FILE_READ FILE_TMPFILE
20    
21     MSG_ERROR MSG_FATAL MSG_MESSAGE MSG_NOTE MSG_PANIC MSG_WARNING
22    
23 root 1.25 OPT_RBUF OPT_WBUF
24 root 1.1 OPT_BRACKPOL OPT_DEBUG OPT_DESPERATE OPT_DUMBNESS OPT_ENCEXT
25     OPT_ERRNO OPT_FAST OPT_IGNMODE OPT_IGNREPLY OPT_OVERWRITE OPT_PREAMB
26     OPT_PROGRESS OPT_SAVEPATH OPT_TINYB64 OPT_USETEXT OPT_VERBOSE
27 root 1.34 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT OPT_AUTOCHECK
28 root 1.1
29     RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA
30     RET_NOEND RET_NOMEM RET_OK RET_UNSUP
31    
32 root 1.11 B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
33 root 1.5 XX_ENCODED UU_ENCODED YENC_ENCODED
34 root 1.1 );
35    
36 root 1.28 our @_funcs = qw(
37 root 1.6 Initialize CleanUp GetOption SetOption strerror SetMsgCallback
38     SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
39 root 1.47 FNameFilter LoadFile GetFileListItem GetFileList RenameFile DecodeToTemp
40 root 1.6 RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
41     EncodePartial EncodeToStream EncodeToFile E_PrepSingle
42 root 1.35 E_PrepPartial
43 root 1.1
44     straction strencoding strmsglevel
45     );
46    
47 root 1.28 our @EXPORT = @_consts;
48     our @EXPORT_OK = @_funcs;
49     our %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
50 root 1.1
51     bootstrap Convert::UUlib $VERSION;
52    
53 root 1.48 # dummy function for compatiiblity with pre-1.7 versions
54     sub Initialize { }
55 root 1.1
56     for (@_consts) {
57 root 1.48 my $constant = constant ($_);
58 root 1.28 no strict 'refs';
59 root 1.1 *$_ = sub () { $constant };
60     }
61    
62     # action code -> string mapping
63     sub straction($) {
64     return 'copying' if $_[0] == &ACT_COPYING;
65     return 'decoding' if $_[0] == &ACT_DECODING;
66     return 'encoding' if $_[0] == &ACT_ENCODING;
67     return 'idle' if $_[0] == &ACT_IDLE;
68     return 'scanning' if $_[0] == &ACT_SCANNING;
69 root 1.5 'unknown';
70 root 1.1 }
71    
72     # encoding type -> string mapping
73     sub strencoding($) {
74 root 1.5 return 'uuencode' if $_[0] == &UU_ENCODED;
75 root 1.11 return 'base64' if $_[0] == &B64_ENCODED;
76 root 1.5 return 'yenc' if $_[0] == &YENC_ENCODED;
77 root 1.1 return 'binhex' if $_[0] == &BH_ENCODED;
78     return 'plaintext' if $_[0] == &PT_ENCODED;
79     return 'quoted-printable' if $_[0] == &QP_ENCODED;
80     return 'xxencode' if $_[0] == &XX_ENCODED;
81 root 1.5 'unknown';
82 root 1.1 }
83    
84     sub strmsglevel($) {
85     return 'message' if $_[0] == &MSG_MESSAGE;
86     return 'note' if $_[0] == &MSG_NOTE;
87     return 'warning' if $_[0] == &MSG_WARNING;
88     return 'error' if $_[0] == &MSG_ERROR;
89     return 'panic' if $_[0] == &MSG_PANIC;
90     return 'fatal' if $_[0] == &MSG_FATAL;
91 root 1.5 'unknown';
92 root 1.1 }
93    
94     1;
95     __END__
96    
97     =head1 NAME
98    
99     Convert::UUlib - Perl interface to the uulib library (a.k.a. uudeview/uuenview).
100    
101     =head1 SYNOPSIS
102    
103     use Convert::UUlib ':all';
104    
105 root 1.11 # read all the files named on the commandline and decode them
106 root 1.13 # into the CURRENT directory. See below for a longer example.
107     LoadFile $_ for @ARGV;
108 root 1.48
109 root 1.47 for my $uu (GetFileList) {
110 root 1.13 if ($uu->state & FILE_OK) {
111     $uu->decode;
112     print $uu->filename, "\n";
113     }
114 root 1.1 }
115    
116 root 1.11 =head1 DESCRIPTION
117 root 1.1
118 root 1.11 Read the file doc/library.pdf from the distribution for in-depth
119     information about the C-library used in this interface, and the rest of
120     this document and especially the non-trivial decoder program at the end.
121    
122     =head1 EXPORTED CONSTANTS
123    
124     =head2 Action code constants
125    
126     ACT_IDLE we don't do anything
127     ACT_SCANNING scanning an input file
128     ACT_DECODING decoding into a temp file
129     ACT_COPYING copying temp to target
130     ACT_ENCODING encoding a file
131    
132     =head2 Message severity levels
133    
134     MSG_MESSAGE just a message, nothing important
135     MSG_NOTE something that should be noticed
136     MSG_WARNING important msg, processing continues
137     MSG_ERROR processing has been terminated
138     MSG_FATAL decoder cannot process further requests
139     MSG_PANIC recovery impossible, app must terminate
140    
141     =head2 Options
142    
143     OPT_VERSION version number MAJOR.MINORplPATCH (ro)
144     OPT_FAST assumes only one part per file
145     OPT_DUMBNESS switch off the program's intelligence
146     OPT_BRACKPOL give numbers in [] higher precendence
147     OPT_VERBOSE generate informative messages
148     OPT_DESPERATE try to decode incomplete files
149     OPT_IGNREPLY ignore RE:plies (off by default)
150     OPT_OVERWRITE whether it's OK to overwrite ex. files
151     OPT_SAVEPATH prefix to save-files on disk
152     OPT_IGNMODE ignore the original file mode
153     OPT_DEBUG print messages with FILE/LINE info
154     OPT_ERRNO get last error code for RET_IOERR (ro)
155     OPT_PROGRESS retrieve progress information
156     OPT_USETEXT handle text messages
157     OPT_PREAMB handle Mime preambles/epilogues
158     OPT_TINYB64 detect short B64 outside of Mime
159     OPT_ENCEXT extension for single-part encoded files
160 root 1.14 OPT_REMOVE remove input files after decoding (dangerous)
161 root 1.11 OPT_MOREMIME strict MIME adherence
162 root 1.15 OPT_DOTDOT ".."-unescaping has not yet been done on input files
163 root 1.35 OPT_RBUF set default read I/O buffer size in bytes
164     OPT_WBUF set default write I/O buffer size in bytes
165     OPT_AUTOCHECK automatically check file list after every loadfile
166 root 1.11
167     =head2 Result/Error codes
168    
169     RET_OK everything went fine
170     RET_IOERR I/O Error - examine errno
171     RET_NOMEM not enough memory
172     RET_ILLVAL illegal value for operation
173     RET_NODATA decoder didn't find any data
174     RET_NOEND encoded data wasn't ended properly
175     RET_UNSUP unsupported function (encoding)
176     RET_EXISTS file exists (decoding)
177     RET_CONT continue -- special from ScanPart
178     RET_CANCEL operation canceled
179    
180     =head2 File States
181    
182     This code is zero, i.e. "false":
183    
184     UUFILE_READ Read in, but not further processed
185    
186 root 1.13 The following state codes are or'ed together:
187 root 1.11
188     FILE_MISPART Missing Part(s) detected
189     FILE_NOBEGIN No 'begin' found
190     FILE_NOEND No 'end' found
191     FILE_NODATA File does not contain valid uudata
192     FILE_OK All Parts found, ready to decode
193     FILE_ERROR Error while decoding
194     FILE_DECODED Successfully decoded
195     FILE_TMPFILE Temporary decoded file exists
196    
197     =head2 Encoding types
198    
199     UU_ENCODED UUencoded data
200     B64_ENCODED Mime-Base64 data
201     XX_ENCODED XXencoded data
202     BH_ENCODED Binhex encoded
203     PT_ENCODED Plain-Text encoded (MIME)
204     QP_ENCODED Quoted-Printable (MIME)
205     YENC_ENCODED yEnc encoded (non-MIME)
206 root 1.1
207 root 1.11 =head1 EXPORTED FUNCTIONS
208 root 1.1
209 root 1.11 =head2 Initializing and cleanup
210 root 1.1
211 root 1.11 Initialize is automatically called when the module is loaded and allocates
212 root 1.13 quite a small amount of memory for todays machines ;) CleanUp releases that
213     again.
214 root 1.14
215     On my machine, a fairly complete decode with DBI backend needs about 10MB
216     RSS to decode 20000 files.
217 root 1.1
218 root 1.46 =over
219 root 1.13
220     =item CleanUp
221    
222 root 1.48 Release memory, file items and clean up files. Should be called after a
223     decoidng run, if you want to start a new one.
224 root 1.13
225     =back
226 root 1.1
227 root 1.11 =head2 Setting and querying options
228 root 1.1
229 root 1.46 =over
230 root 1.13
231     =item $option = GetOption OPT_xxx
232    
233     =item SetOption OPT_xxx, opt-value
234    
235     =back
236    
237     See the C<OPT_xxx> constants above to see which options exist.
238 root 1.1
239 root 1.11 =head2 Setting various callbacks
240 root 1.1
241 root 1.46 =over
242 root 1.13
243     =item SetMsgCallback [callback-function]
244    
245     =item SetBusyCallback [callback-function]
246    
247     =item SetFileCallback [callback-function]
248    
249     =item SetFNameFilter [callback-function]
250    
251     =back
252 root 1.1
253 root 1.11 =head2 Call the currently selected FNameFilter
254 root 1.1
255 root 1.46 =over
256 root 1.13
257     =item $file = FNameFilter $file
258    
259     =back
260 root 1.1
261 root 1.11 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
262 root 1.1
263 root 1.46 =over
264 root 1.13
265 root 1.16 =item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
266 root 1.13
267     Load the given file and scan it for encoded contents. Optionally tag it
268 root 1.16 with the given id, and if C<$delflag> is true, delete the file after it
269 root 1.18 is no longer necessary. If you are certain of the part number, you can
270     specify it as the last argument.
271 root 1.16
272     A better (usually faster) way of doing this is using the C<SetFNameFilter>
273     functionality.
274 root 1.13
275     =item $retval = Smerge $pass
276    
277     If you are desperate, try to call C<Smerge> with increasing C<$pass>
278     values, beginning at C<0>, to try to merge parts that usually would not
279     have been merged.
280    
281     Most probably this will result in garbled files, so never do this by
282 root 1.35 default, except:
283    
284     If the C<OPT_AUTOCHECK> option has been disabled (by default it is
285     enabled) to speed up file loading, then you I<have> to call C<Smerge -1>
286     after loading all files as an additional pre-pass (which is normally done
287     by C<LoadFile>).
288 root 1.13
289     =item $item = GetFileListItem $item_number
290    
291     Return the C<$item> structure for the C<$item_number>'th found file, or
292     C<undef> of no file with that number exists.
293    
294     The first file has number C<0>, and the series has no holes, so you can
295     iterate over all files by starting with zero and incrementing until you
296     hit C<undef>.
297    
298 root 1.47 This function has to walk the linear list of fils on each access, so
299     if you want to iterate over all items, it is usually faster to use
300     C<GetFileList>.
301    
302     =item @items = GetFileList
303    
304     Similar to C<GetFileListItem>, but returns all files in one go.
305    
306 root 1.13 =back
307    
308     =head2 Decoding files
309    
310 root 1.46 =over
311 root 1.13
312 root 1.46 =item $retval = $item->rename ($newname)
313 root 1.13
314     Change the ondisk filename where the decoded file will be saved.
315    
316     =item $retval = $item->decode_temp
317    
318     Decode the file into a temporary location, use C<< $item->infile >> to
319     retrieve the temporary filename.
320    
321     =item $retval = $item->remove_temp
322    
323     Remove the temporarily decoded file again.
324    
325 root 1.46 =item $retval = $item->decode ([$target_path])
326 root 1.13
327 root 1.46 Decode the file to its destination, or the given target path.
328 root 1.13
329 root 1.46 =item $retval = $item->info (callback-function)
330 root 1.13
331     =back
332 root 1.1
333 root 1.11 =head2 Querying (and setting) item attributes
334 root 1.1
335 root 1.46 =over
336 root 1.13
337     =item $state = $item->state
338    
339 root 1.46 =item $mode = $item->mode ([newmode])
340 root 1.13
341     =item $uudet = $item->uudet
342    
343     =item $size = $item->size
344    
345 root 1.46 =item $filename = $item->filename ([newfilename})
346 root 1.13
347     =item $subfname = $item->subfname
348    
349     =item $mimeid = $item->mimeid
350    
351     =item $mimetype = $item->mimetype
352    
353     =item $binfile = $item->binfile
354    
355     =back
356    
357     =head2 Information about source parts
358    
359 root 1.46 =over
360 root 1.13
361     =item $parts = $item->parts
362    
363     Return information about all parts (source files) used to decode the file
364     as a list of hashrefs with the following structure:
365    
366     {
367     partno => <integer describing the part number, starting with 1>,
368     # the following member sonly exist when they contain useful information
369     sfname => <local pathname of the file where this part is from>,
370     filename => <the ondisk filename of the decoded file>,
371     subfname => <used to cluster postings, possibly the posting filename>,
372     subject => <the subject of the posting/mail>,
373     origin => <the possible source (From) address>,
374     mimetype => <the possible mimetype of the decoded file>,
375     mimeid => <the id part of the Content-Type>,
376     }
377 root 1.1
378 root 1.13 Usually you are interested mostly the C<sfname> and possibly the C<partno>
379     and C<filename> members.
380 root 1.1
381 root 1.13 =back
382 root 1.1
383 root 1.46 =head2 Functions below are not documented and not very well tested - feedback welcome
384 root 1.1
385 root 1.11 QuickDecode
386     EncodeMulti
387     EncodePartial
388     EncodeToStream
389     EncodeToFile
390     E_PrepSingle
391     E_PrepPartial
392 root 1.6
393     =head2 EXTENSION FUNCTIONS
394    
395     Functions found in this module but not documented in the uulib documentation:
396    
397 root 1.46 =over
398 root 1.6
399 root 1.11 =item $msg = straction ACT_xxx
400    
401     Return a human readable string representing the given action code.
402    
403     =item $msg = strerror RET_xxx
404    
405     Return a human readable string representing the given error code.
406    
407     =item $str = strencoding xxx_ENCODED
408    
409     Return the name of the encoding type as a string.
410    
411     =item $str = strmsglevel MSG_xxx
412    
413     Returns the message level as a string.
414    
415 root 1.6 =item SetFileNameCallback $cb
416    
417     Sets (or queries) the FileNameCallback, which is called whenever the
418     decoding library can't find a filename and wants to extract a filename
419     from the subject line of a posting. The callback will be called with
420     two arguments, the subject line and the current candidate for the
421     filename. The latter argument can be C<undef>, which means that no
422     filename could be found (and likely no one exists, so it is safe to also
423     return C<undef> in this case). If it doesn't return anything (not even
424     C<undef>!), then nothing happens, so this is a no-op callback:
425    
426     sub cb {
427     return ();
428     }
429    
430     If it returns C<undef>, then this indicates that no filename could be
431     found. In all other cases, the return value is taken to be the filename.
432    
433     This is a slightly more useful callback:
434    
435     sub cb {
436     return unless $_[1]; # skip "Re:"-plies et al.
437     my ($subject, $filename) = @_;
438     # if we find some *.rar, take it
439     return $1 if $subject =~ /(\w+\.rar)/;
440     # otherwise just pass what we have
441     return ();
442     }
443    
444     =back
445 root 1.1
446 root 1.11 =head1 LARGE EXAMPLE DECODER
447    
448 root 1.48 The general workflow for decoding is like this:
449    
450     =over
451    
452     =item 1. Configure options with C<SetOption> or C<SetXXXCallback>.
453    
454     =item 2. Load all source files with C<LoadFile>.
455    
456     =item 3. Optionally C<Smerge>.
457    
458     =item 4. Iterate over all C<GetFileList> items (i.e. result files).
459    
460     =item 5. C<CleanUp> to delete files and free items.
461    
462     =back
463    
464     What follows is the file C<example-decoder> from the distribution that
465     illustrates the above worklfow in a non-trivial example.
466 root 1.11
467 root 1.32 #!/usr/bin/perl
468 root 1.11
469 root 1.32 # decode all the files in the directory uusrc/ and copy
470     # the resulting files to uudst/
471 root 1.11
472 root 1.32 use Convert::UUlib ':all';
473 root 1.11
474 root 1.32 sub namefilter {
475     my ($path) = @_;
476 root 1.11
477 root 1.32 $path=~s/^.*[\/\\]//;
478 root 1.11
479 root 1.32 $path
480     }
481 root 1.11
482 root 1.32 sub busycb {
483     my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
484     $_[0]=straction($action);
485     print "busy_callback(", (join ",",@_), ")\n";
486     0
487     }
488 root 1.11
489 root 1.32 SetOption OPT_RBUF, 128*1024;
490     SetOption OPT_WBUF, 1024*1024;
491     SetOption OPT_IGNMODE, 1;
492     SetOption OPT_IGNMODE, 1;
493     SetOption OPT_VERBOSE, 1;
494    
495     # show the three ways you can set callback functions. I normally
496     # prefer the one with the sub inplace.
497     SetFNameFilter \&namefilter;
498    
499     SetBusyCallback "busycb", 333;
500    
501     SetMsgCallback sub {
502     my ($msg, $level) = @_;
503     print uc strmsglevel $_[1], ": $msg\n";
504     };
505    
506     # the following non-trivial FileNameCallback takes care
507     # of some subject lines not detected properly by uulib:
508     SetFileNameCallback sub {
509     return unless $_[1]; # skip "Re:"-plies et al.
510     local $_ = $_[0];
511    
512     # the following rules are rather effective on some newsgroups,
513     # like alt.binaries.games.anime, where non-mime, uuencoded data
514     # is very common
515    
516     # if we find some *.rar, take it as the filename
517     return $1 if /(\S{3,}\.(?:[rstuvwxyz]\d\d|rar))\s/i;
518    
519     # one common subject format
520     return $1 if /- "(.{2,}?\..+?)" (?:yenc )?\(\d+\/\d+\)/i;
521    
522     # - filename.par (04/55)
523     return $1 if /- "?(\S{3,}\.\S+?)"? (?:yenc )?\(\d+\/\d+\)/i;
524    
525     # - (xxx) No. 1 sayuri81.jpg 756565 bytes
526     # - (20 files) No.17 Roseanne.jpg [2/2]
527     return $1 if /No\.[ 0-9]+ (\S+\....) (?:\d+ bytes )?\[/;
528    
529     # try to detect some common forms of filenames
530     return $1 if /([a-z0-9_\-+.]{3,}\.[a-z]{3,4}(?:.\d+))/i;
531    
532     # otherwise just pass what we have
533     ()
534     };
535    
536     # now read all files in the directory uusrc/*
537 root 1.47 for (<uusrc/*>) {
538 root 1.32 my ($retval, $count) = LoadFile ($_, $_, 1);
539     print "file($_), status(", strerror $retval, ") parts($count)\n";
540     }
541 root 1.11
542 root 1.32 SetOption OPT_SAVEPATH, "uudst/";
543 root 1.11
544 root 1.32 # now wade through all files and their source parts
545 root 1.47 for my $uu (GetFileList) {
546     print "file ", $uu->filename, "\n";
547     print " state ", $uu->state, "\n";
548     print " mode ", $uu->mode, "\n";
549     print " uudet ", strencoding $uu->uudet, "\n";
550     print " size ", $uu->size, "\n";
551     print " subfname ", $uu->subfname, "\n";
552     print " mimeid ", $uu->mimeid, "\n";
553     print " mimetype ", $uu->mimetype, "\n";
554 root 1.32
555     # print additional info about all parts
556 root 1.47 print " parts";
557 root 1.32 for ($uu->parts) {
558 root 1.47 for my $k (sort keys %$_) {
559     print " $k=$_->{$k}";
560 root 1.32 }
561     print "\n";
562     }
563    
564     $uu->remove_temp;
565    
566 root 1.47 if (my $err = $uu->decode) {
567     print " ERROR ", strerror $err, "\n";
568 root 1.32 } else {
569 root 1.47 print " successfully saved as uudst/", $uu->filename, "\n";
570 root 1.32 }
571     }
572 root 1.11
573 root 1.32 print "cleanup...\n";
574 root 1.11
575 root 1.32 CleanUp;
576 root 1.11
577 root 1.46 =head1 PERLMULTICORE SUPPORT
578    
579     This module supports the perlmulticore standard (see
580     L<http://perlmulticore.schmorp.de/> for more info) for the following
581     functions - generally these are functions accessing the disk and/or using
582     considerable CPU time:
583    
584     LoadFile
585     $item->decode
586     $item->decode_temp
587     $item->remove_temp
588     $item->info
589    
590     The perl interpreter will be reacquired/released on every callback
591     invocation, so for performance reasons, callbacks should be avoided if
592     that is costly.
593    
594     Future versions might enable multicore support for more functions.
595    
596 root 1.45 =head1 BUGS AND LIMITATIONS
597    
598     The original uulib library this module uses was written at a time where
599     main memory of measured in megabytes and buffer overflows as a security
600     thign didn't exist. While a lot of security fixes have been applied over
601     the years (includign some defense in depth mechanism that can shield
602     against a lot of as-of-yet undetected bugs), using this library for
603     security purposes requires care.
604    
605     Likewise, file sizes when the uulib library was written were tiny compared
606     to today, so do not expect this library to handle files larger than 2GB.
607    
608 root 1.1 =head1 AUTHOR
609    
610 root 1.23 Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
611 root 1.11 by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
612     bugfixed by Marc Lehmann.
613 root 1.1
614     =head1 SEE ALSO
615    
616 root 1.45 perl(1), uudeview homepage at L<http://www.fpx.de/fp/Software/UUDeview/>.
617 root 1.1
618     =cut
619 root 1.45