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