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

# 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 # dummy function for compatiiblity with pre-1.7 versions
54 sub Initialize { }
55
56 for (@_consts) {
57 my $constant = constant ($_);
58 no strict 'refs';
59 *$_ = 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 'unknown';
70 }
71
72 # encoding type -> string mapping
73 sub strencoding($) {
74 return 'uuencode' if $_[0] == &UU_ENCODED;
75 return 'base64' if $_[0] == &B64_ENCODED;
76 return 'yenc' if $_[0] == &YENC_ENCODED;
77 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 'unknown';
82 }
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 'unknown';
92 }
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 # read all the files named on the commandline and decode them
106 # into the CURRENT directory. See below for a longer example.
107 LoadFile $_ for @ARGV;
108
109 for my $uu (GetFileList) {
110 if ($uu->state & FILE_OK) {
111 $uu->decode;
112 print $uu->filename, "\n";
113 }
114 }
115
116 =head1 DESCRIPTION
117
118 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 OPT_REMOVE remove input files after decoding (dangerous)
161 OPT_MOREMIME strict MIME adherence
162 OPT_DOTDOT ".."-unescaping has not yet been done on input files
163 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
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 The following state codes are or'ed together:
187
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
207 =head1 EXPORTED FUNCTIONS
208
209 =head2 Initializing and cleanup
210
211 Initialize is automatically called when the module is loaded and allocates
212 quite a small amount of memory for todays machines ;) CleanUp releases that
213 again.
214
215 On my machine, a fairly complete decode with DBI backend needs about 10MB
216 RSS to decode 20000 files.
217
218 =over
219
220 =item CleanUp
221
222 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
225 =back
226
227 =head2 Setting and querying options
228
229 =over
230
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
239 =head2 Setting various callbacks
240
241 =over
242
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
253 =head2 Call the currently selected FNameFilter
254
255 =over
256
257 =item $file = FNameFilter $file
258
259 =back
260
261 =head2 Loading sourcefiles, optionally fuzzy merge and start decoding
262
263 =over
264
265 =item ($retval, $count) = LoadFile $fname, [$id, [$delflag, [$partno]]]
266
267 Load the given file and scan it for encoded contents. Optionally tag it
268 with the given id, and if C<$delflag> is true, delete the file after it
269 is no longer necessary. If you are certain of the part number, you can
270 specify it as the last argument.
271
272 A better (usually faster) way of doing this is using the C<SetFNameFilter>
273 functionality.
274
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 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
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 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 =back
307
308 =head2 Decoding files
309
310 =over
311
312 =item $retval = $item->rename ($newname)
313
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 =item $retval = $item->decode ([$target_path])
326
327 Decode the file to its destination, or the given target path.
328
329 =item $retval = $item->info (callback-function)
330
331 =back
332
333 =head2 Querying (and setting) item attributes
334
335 =over
336
337 =item $state = $item->state
338
339 =item $mode = $item->mode ([newmode])
340
341 =item $uudet = $item->uudet
342
343 =item $size = $item->size
344
345 =item $filename = $item->filename ([newfilename})
346
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 =over
360
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
378 Usually you are interested mostly the C<sfname> and possibly the C<partno>
379 and C<filename> members.
380
381 =back
382
383 =head2 Functions below are not documented and not very well tested - feedback welcome
384
385 QuickDecode
386 EncodeMulti
387 EncodePartial
388 EncodeToStream
389 EncodeToFile
390 E_PrepSingle
391 E_PrepPartial
392
393 =head2 EXTENSION FUNCTIONS
394
395 Functions found in this module but not documented in the uulib documentation:
396
397 =over
398
399 =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 =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
446 =head1 LARGE EXAMPLE DECODER
447
448 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
467 #!/usr/bin/perl
468
469 # decode all the files in the directory uusrc/ and copy
470 # the resulting files to uudst/
471
472 use Convert::UUlib ':all';
473
474 sub namefilter {
475 my ($path) = @_;
476
477 $path=~s/^.*[\/\\]//;
478
479 $path
480 }
481
482 sub busycb {
483 my ($action, $curfile, $partno, $numparts, $percent, $fsize) = @_;
484 $_[0]=straction($action);
485 print "busy_callback(", (join ",",@_), ")\n";
486 0
487 }
488
489 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 for (<uusrc/*>) {
538 my ($retval, $count) = LoadFile ($_, $_, 1);
539 print "file($_), status(", strerror $retval, ") parts($count)\n";
540 }
541
542 SetOption OPT_SAVEPATH, "uudst/";
543
544 # now wade through all files and their source parts
545 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
555 # print additional info about all parts
556 print " parts";
557 for ($uu->parts) {
558 for my $k (sort keys %$_) {
559 print " $k=$_->{$k}";
560 }
561 print "\n";
562 }
563
564 $uu->remove_temp;
565
566 if (my $err = $uu->decode) {
567 print " ERROR ", strerror $err, "\n";
568 } else {
569 print " successfully saved as uudst/", $uu->filename, "\n";
570 }
571 }
572
573 print "cleanup...\n";
574
575 CleanUp;
576
577 =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 =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 =head1 AUTHOR
609
610 Marc Lehmann <schmorp@schmorp.de>, the original uulib library was written
611 by Frank Pilhofer <fp@informatik.uni-frankfurt.de>, and later heavily
612 bugfixed by Marc Lehmann.
613
614 =head1 SEE ALSO
615
616 perl(1), uudeview homepage at L<http://www.fpx.de/fp/Software/UUDeview/>.
617
618 =cut
619