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

# Content
1 package Convert::UUlib;
2
3 no warnings;
4 use strict;
5
6 use Carp;
7
8 require Exporter;
9 require DynaLoader;
10
11 our $VERSION = 1.62;
12
13 our @ISA = qw(Exporter DynaLoader);
14
15 our @_consts = qw(
16 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 OPT_RBUF OPT_WBUF
24 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 OPT_VERSION OPT_REMOVE OPT_MOREMIME OPT_DOTDOT OPT_AUTOCHECK
28
29 RET_CANCEL RET_CONT RET_EXISTS RET_ILLVAL RET_IOERR RET_NODATA
30 RET_NOEND RET_NOMEM RET_OK RET_UNSUP
31
32 B64_ENCODED BH_ENCODED PT_ENCODED QP_ENCODED
33 XX_ENCODED UU_ENCODED YENC_ENCODED
34 );
35
36 our @_funcs = qw(
37 Initialize CleanUp GetOption SetOption strerror SetMsgCallback
38 SetBusyCallback SetFileCallback SetFNameFilter SetFileNameCallback
39 FNameFilter LoadFile GetFileListItem GetFileList RenameFile DecodeToTemp
40 RemoveTemp DecodeFile InfoFile Smerge QuickDecode EncodeMulti
41 EncodePartial EncodeToStream EncodeToFile E_PrepSingle
42 E_PrepPartial
43
44 straction strencoding strmsglevel
45 );
46
47 our @EXPORT = @_consts;
48 our @EXPORT_OK = @_funcs;
49 our %EXPORT_TAGS = (all => [@_consts,@_funcs], constants => \@_consts);
50
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 no strict 'refs';
61 *$_ = 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 'unknown';
72 }
73
74 # encoding type -> string mapping
75 sub strencoding($) {
76 return 'uuencode' if $_[0] == &UU_ENCODED;
77 return 'base64' if $_[0] == &B64_ENCODED;
78 return 'yenc' if $_[0] == &YENC_ENCODED;
79 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 'unknown';
84 }
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 'unknown';
94 }
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 # read all the files named on the commandline and decode them
108 # into the CURRENT directory. See below for a longer example.
109 LoadFile $_ for @ARGV;
110 for my $uu (GetFileList) {
111 if ($uu->state & FILE_OK) {
112 $uu->decode;
113 print $uu->filename, "\n";
114 }
115 }
116
117 =head1 DESCRIPTION
118
119 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 OPT_REMOVE remove input files after decoding (dangerous)
162 OPT_MOREMIME strict MIME adherence
163 OPT_DOTDOT ".."-unescaping has not yet been done on input files
164 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
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 The following state codes are or'ed together:
188
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
208 =head1 EXPORTED FUNCTIONS
209
210 =head2 Initializing and cleanup
211
212 Initialize is automatically called when the module is loaded and allocates
213 quite a small amount of memory for todays machines ;) CleanUp releases that
214 again.
215
216 On my machine, a fairly complete decode with DBI backend needs about 10MB
217 RSS to decode 20000 files.
218
219 =over
220
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
232 =head2 Setting and querying options
233
234 =over
235
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
244 =head2 Setting various callbacks
245
246 =over
247
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
258 =head2 Call the currently selected FNameFilter
259
260 =over
261
262 =item $file = FNameFilter $file
263
264 =back
265
266 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
267
268 =over
269
270 =item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
271
272 Load the given file and scan it for encoded contents. Optionally tag it
273 with the given id, and if C<$delflag> is true, delete the file after it
274 is no longer necessary. If you are certain of the part number, you can
275 specify it as the last argument.
276
277 A better (usually faster) way of doing this is using the C<SetFNameFilter>
278 functionality.
279
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 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
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 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 =back
312
313 =head2 Decoding files
314
315 =over
316
317 =item $retval = $item->rename ($newname)
318
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 =item $retval = $item->decode ([$target_path])
331
332 Decode the file to its destination, or the given target path.
333
334 =item $retval = $item->info (callback-function)
335
336 =back
337
338 =head2 Querying (and setting) item attributes
339
340 =over
341
342 =item $state = $item->state
343
344 =item $mode = $item->mode ([newmode])
345
346 =item $uudet = $item->uudet
347
348 =item $size = $item->size
349
350 =item $filename = $item->filename ([newfilename})
351
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 =over
365
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
383 Usually you are interested mostly the C<sfname> and possibly the C<partno>
384 and C<filename> members.
385
386 =back
387
388 =head2 Functions below are not documented and not very well tested - feedback welcome
389
390 QuickDecode
391 EncodeMulti
392 EncodePartial
393 EncodeToStream
394 EncodeToFile
395 E_PrepSingle
396 E_PrepPartial
397
398 =head2 EXTENSION FUNCTIONS
399
400 Functions found in this module but not documented in the uulib documentation:
401
402 =over
403
404 =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 =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
451 =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 #!/usr/bin/perl
457
458 # decode all the files in the directory uusrc/ and copy
459 # the resulting files to uudst/
460
461 use Convert::UUlib ':all';
462
463 sub namefilter {
464 my ($path) = @_;
465
466 $path=~s/^.*[\/\\]//;
467
468 $path
469 }
470
471 sub busycb {
472 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
473 $_[0]=straction($action);
474 print "busy_callback(", (join ",",@_), ")\n";
475 0
476 }
477
478 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 for (<uusrc/*>) {
527 my ($retval, $count) = LoadFile ($_, $_, 1);
528 print "file($_), status(", strerror $retval, ") parts($count)\n";
529 }
530
531 SetOption OPT_SAVEPATH, "uudst/";
532
533 # now wade through all files and their source parts
534 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
544 # print additional info about all parts
545 print " parts";
546 for ($uu->parts) {
547 for my $k (sort keys %$_) {
548 print " $k=$_->{$k}";
549 }
550 print "\n";
551 }
552
553 $uu->remove_temp;
554
555 if (my $err = $uu->decode) {
556 print " ERROR ", strerror $err, "\n";
557 } else {
558 print " successfully saved as uudst/", $uu->filename, "\n";
559 }
560 }
561
562 print "cleanup...\n";
563
564 CleanUp;
565
566 =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 =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 =head1 AUTHOR
598
599 Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
600 by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
601 bugfixed by Marc Lehmann.
602
603 =head1 SEE ALSO
604
605 perl(1), uudeview homepage at L<http://www.fpx.de/fp/Software/UUDeview/>.
606
607 =cut
608