ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-UUlib/UUlib.pm
Revision: 1.54
Committed: Sat Dec 12 10:48:39 2020 UTC (3 years, 5 months ago) by root
Branch: MAIN
Changes since 1.53: +3 -1 lines
Log Message:
*** empty log message ***

File Contents

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