xref: /openbsd/usr.sbin/pkg_add/OpenBSD/Ustar.pm (revision 5bbd7c03) 
1# ex:ts=8 sw=4:
2# $OpenBSD: Ustar.pm,v 1.76 2014/01/13 18:42:34 espie Exp $
3#
4# Copyright (c) 2002-2014 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18# Handle utar archives
19
20use strict;
21use warnings;
22
23package OpenBSD::Ustar;
24
25use constant {
26	FILE => "\0",
27	FILE1 => '0',
28	HARDLINK => '1',
29	SOFTLINK => '2',
30	CHARDEVICE => '3',
31	BLOCKDEVICE => '4',
32	DIR => '5',
33	FIFO => '6',
34	CONTFILE => '7',
35	USTAR_HEADER => 'a100a8a8a8a12a12a8aa100a6a2a32a32a8a8a155a12',
36	MAXFILENAME => 100,
37	MAXLINKNAME => 100,
38	MAXPREFIX => 155,
39	MAXUSERNAME => 32,
40	MAXGROUPNAME => 32
41};
42
43use File::Basename ();
44use OpenBSD::IdCache;
45use OpenBSD::Paths;
46
47my $uidcache = new OpenBSD::UidCache;
48my $gidcache = new OpenBSD::GidCache;
49my $unamecache = new OpenBSD::UnameCache;
50my $gnamecache = new OpenBSD::GnameCache;
51
52# This is a multiple of st_blksize everywhere....
53my $buffsize = 2 * 1024 * 1024;
54
55sub new
56{
57	my ($class, $fh, $state, $destdir) = @_;
58
59	$destdir = '' unless defined $destdir;
60
61	return bless {
62	    fh => $fh,
63	    swallow => 0,
64	    state => $state,
65	    key => {},
66	    destdir => $destdir} , $class;
67}
68
69sub set_description
70{
71	my ($self, $d) = @_;
72	$self->{description} = $d;
73}
74
75sub fatal
76{
77	my ($self, $msg, @args) = @_;
78	$self->{state}->fatal("Ustar [#1][#2]: #3",
79	    $self->{description} // '?', $self->{lastname} // '?',
80	    $self->{state}->f($msg, @args));
81}
82
83sub new_object
84{
85	my ($self, $h, $class) = @_;
86	$h->{archive} = $self;
87	$h->{destdir} = $self->{destdir};
88	bless $h, $class;
89	return $h;
90}
91
92sub skip
93{
94	my $self = shift;
95	my $temp;
96
97	while ($self->{swallow} > 0) {
98		my $toread = $self->{swallow};
99		if ($toread >$buffsize) {
100			$toread = $buffsize;
101		}
102		my $actual = read($self->{fh}, $temp, $toread);
103		if (!defined $actual) {
104			$self->fatal("Error while skipping archive: #1", $!);
105		}
106		if ($actual == 0) {
107			$self->fatal("Premature end of archive in header: #1", $!);
108		}
109		$self->{swallow} -= $actual;
110	}
111}
112
113my $types = {
114	DIR , 'OpenBSD::Ustar::Dir',
115	HARDLINK , 'OpenBSD::Ustar::HardLink',
116	SOFTLINK , 'OpenBSD::Ustar::SoftLink',
117	FILE , 'OpenBSD::Ustar::File',
118	FILE1 , 'OpenBSD::Ustar::File',
119	FIFO , 'OpenBSD::Ustar::Fifo',
120	CHARDEVICE , 'OpenBSD::Ustar::CharDevice',
121	BLOCKDEVICE , 'OpenBSD::Ustar::BlockDevice',
122};
123
124sub next
125{
126	my $self = shift;
127	# get rid of the current object
128	$self->skip;
129	my $header;
130	my $n = read($self->{fh}, $header, 512);
131	return if (defined $n) and $n == 0;
132	$self->fatal("Error while reading header")
133	    unless defined $n and $n == 512;
134	if ($header eq "\0"x512) {
135		return $self->next;
136	}
137	# decode header
138	my ($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
139	    $linkname, $magic, $version, $uname, $gname, $major, $minor,
140	    $prefix, $pad) = unpack(USTAR_HEADER, $header);
141	if ($magic ne "ustar\0" || $version ne '00') {
142		$self->fatal("Not an ustar archive header");
143	}
144	# verify checksum
145	my $value = $header;
146	substr($value, 148, 8) = " "x8;
147	my $ck2 = unpack("%C*", $value);
148	if ($ck2 != oct($chksum)) {
149		$self->fatal("Bad archive checksum");
150	}
151	$name =~ s/\0*$//o;
152	$mode = oct($mode) & 0xfff;
153	$uname =~ s/\0*$//o;
154	$gname =~ s/\0*$//o;
155	$linkname =~ s/\0*$//o;
156	$major = oct($major);
157	$minor = oct($minor);
158	$uid = oct($uid);
159	$gid = oct($gid);
160	$uid = $uidcache->lookup($uname, $uid);
161	$gid = $gidcache->lookup($gname, $gid);
162	{
163		no warnings; # XXX perl warns if oct converts >= 2^32 values
164		$mtime = oct($mtime);
165	}
166	unless ($prefix =~ m/^\0/o) {
167		$prefix =~ s/\0*$//o;
168		$name = "$prefix/$name";
169	}
170
171	$self->{lastname} = $name;
172	$size = oct($size);
173	my $result= {
174	    name => $name,
175	    mode => $mode,
176	    atime => $mtime,
177	    mtime => $mtime,
178	    linkname=> $linkname,
179	    uname => $uname,
180	    uid => $uid,
181	    gname => $gname,
182	    gid => $gid,
183	    size => $size,
184	    major => $major,
185	    minor => $minor,
186	};
187	if (defined $types->{$type}) {
188		$self->new_object($result, $types->{$type});
189	} else {
190		$self->fatal("Unsupported type #1", $type);
191	}
192	if (!$result->isFile && $result->{size} != 0) {
193		$self->fatal("Bad archive: non null size for #1 (#2)",
194		    $types->{$type}, $result->{name});
195	}
196
197	# adjust swallow
198	$self->{swallow} = $size;
199	if ($size % 512) {
200		$self->{swallow} += 512 - $size % 512;
201	}
202	$self->{cachename} = $name;
203	return $result;
204}
205
206sub split_name
207{
208	my $name = shift;
209	my $prefix = '';
210
211	my $l = length $name;
212	if ($l > MAXFILENAME && $l <= MAXFILENAME+MAXPREFIX+1) {
213		while (length($name) > MAXFILENAME &&
214		    $name =~ m/^(.*?\/)(.*)$/o) {
215			$prefix .= $1;
216			$name = $2;
217		}
218		$prefix =~ s|/$||;
219	}
220	return ($prefix, $name);
221}
222
223sub mkheader
224{
225	my ($archive, $entry, $type) = @_;
226	my ($prefix, $name) = split_name($entry->name);
227	my $linkname = $entry->{linkname};
228	my $size = $entry->{size};
229	my ($major, $minor);
230	if ($entry->isDevice) {
231		$major = $entry->{major};
232		$minor = $entry->{minor};
233	} else {
234		$major = 0;
235		$minor = 0;
236	}
237	my ($uname, $gname);
238	if (defined $entry->{uname}) {
239		$uname = $entry->{uname};
240	} else {
241		$uname = $entry->{uid};
242	}
243	if (defined $entry->{gname}) {
244		$gname = $entry->{gname};
245	} else {
246		$gname = $entry->{gid};
247	}
248
249	if (defined $entry->{cwd}) {
250		my $cwd = $entry->{cwd};
251		$cwd.='/' unless $cwd =~ m/\/$/o;
252		$linkname =~ s/^\Q$cwd\E//;
253	}
254	if (!defined $linkname) {
255		$linkname = '';
256	}
257	if (length $prefix > MAXPREFIX) {
258		$archive->fatal("Prefix too long #1", $prefix);
259	}
260	if (length $name > MAXFILENAME) {
261		$archive->fatal("Name too long #1", $name);
262	}
263	if (length $linkname > MAXLINKNAME) {
264		$archive->fatal("Linkname too long #1", $linkname);
265	}
266	if (length $uname > MAXUSERNAME) {
267		$archive->fatal("Username too long #1", $uname);
268	}
269	if (length $gname > MAXGROUPNAME) {
270		$archive->fatal("Groupname too long #1", $gname);
271	}
272	my $header;
273	my $cksum = ' 'x8;
274	for (1 .. 2) {
275		$header = pack(USTAR_HEADER,
276		    $name,
277		    sprintf("%07o", $entry->{mode}),
278		    sprintf("%07o", $entry->{uid}),
279		    sprintf("%07o", $entry->{gid}),
280		    sprintf("%011o", $size),
281		    sprintf("%011o", $entry->{mtime}),
282		    $cksum,
283		    $type,
284		    $linkname,
285		    'ustar', '00',
286		    $uname,
287		    $gname,
288		    sprintf("%07o", $major),
289		    sprintf("%07o", $minor),
290		    $prefix, "\0");
291		$cksum = sprintf("%07o", unpack("%C*", $header));
292	}
293	return $header;
294}
295
296sub prepare
297{
298	my ($self, $filename, $destdir) = @_;
299
300	$destdir //= $self->{destdir};
301	my $realname = "$destdir/$filename";
302
303	my ($dev, $ino, $mode, $uid, $gid, $rdev, $size, $mtime) =
304	    (lstat $realname)[0,1,2,4,5,6, 7,9];
305
306	my $entry = {
307		key => "$dev/$ino",
308		name => $filename,
309		realname => $realname,
310		mode => $mode,
311		uid => $uid,
312		gid => $gid,
313		size => $size,
314		mtime => $mtime,
315		uname => $unamecache->lookup($uid),
316		gname => $gnamecache->lookup($gid),
317		major => $rdev/256,
318		minor => $rdev%256,
319	};
320	my $k = $entry->{key};
321	my $class = "OpenBSD::Ustar::File"; # default
322	if (defined $self->{key}{$k}) {
323		$entry->{linkname} = $self->{key}{$k};
324		$class = "OpenBSD::Ustar::HardLink";
325	} elsif (-l $realname) {
326		$entry->{linkname} = readlink($realname);
327		$class = "OpenBSD::Ustar::SoftLink";
328	} elsif (-p _) {
329		$class = "OpenBSD::Ustar::Fifo";
330	} elsif (-c _) {
331		$class = "OpenBSD::Ustar::CharDevice";
332	} elsif (-b _) {
333		$class ="OpenBSD::Ustar::BlockDevice";
334	} elsif (-d _) {
335		$class = "OpenBSD::Ustar::Dir";
336	}
337	$self->new_object($entry, $class);
338	if (!$entry->isFile) {
339		$entry->{size} = 0;
340	}
341	return $entry;
342}
343
344sub pad
345{
346	my $self = shift;
347	my $fh = $self->{fh};
348	print $fh "\0"x1024 or $self->fatal("Error writing to archive: #1", $!);
349}
350
351sub close
352{
353	my $self = shift;
354	if (defined $self->{padout}) {
355	    $self->pad;
356	}
357	close($self->{fh});
358}
359
360sub destdir
361{
362	my $self = shift;
363	if (@_ > 0) {
364		$self->{destdir} = shift;
365	} else {
366		return $self->{destdir};
367	}
368}
369
370sub fh
371{
372	return $_[0]->{fh};
373}
374
375package OpenBSD::Ustar::Object;
376
377sub fatal
378{
379	my ($self, @args) = @_;
380	$self->{archive}->fatal(@args);
381}
382
383sub system
384{
385	my ($self, @args) = @_;
386	$self->{archive}{state}->system(@args);
387}
388
389sub errsay
390{
391	my ($self, @args) = @_;
392	$self->{archive}{state}->errsay(@args);
393}
394sub todo
395{
396	my ($self, $toread) = @_;
397	return if $toread == 0;
398	return unless defined $self->{archive}{callback};
399	&{$self->{archive}{callback}}($self->{size} - $toread);
400}
401
402sub name
403{
404	my $self = shift;
405	return $self->{name};
406}
407
408sub set_name
409{
410	my ($self, $v) = @_;
411	$self->{name} = $v;
412}
413
414sub set_modes
415{
416	my $self = shift;
417	chown $self->{uid}, $self->{gid}, $self->{destdir}.$self->name;
418	chmod $self->{mode}, $self->{destdir}.$self->name;
419	if (defined $self->{mtime} || defined $self->{atime}) {
420		utime $self->{atime} // time, $self->{mtime} // time,
421		    $self->{destdir}.$self->name;
422	}
423}
424
425sub ensure_dir
426{
427	my ($self, $dir) = @_;
428	return if -d $dir;
429	$self->ensure_dir(File::Basename::dirname($dir));
430	if (mkdir($dir)) {
431		return;
432	}
433	$self->fatal("Error making directory #1: #2", $dir, $!);
434}
435
436sub make_basedir
437{
438	my $self = shift;
439	my $dir = $self->{destdir}.File::Basename::dirname($self->name);
440	$self->ensure_dir($dir);
441}
442
443sub write
444{
445	my $self = shift;
446	my $arc = $self->{archive};
447	my $out = $arc->{fh};
448
449	$arc->{padout} = 1;
450	my $header = $arc->mkheader($self, $self->type);
451	print $out $header or $self->fatal("Error writing to archive: #1", $!);
452	$self->write_contents($arc);
453	my $k = $self->{key};
454	if (!defined $arc->{key}{$k}) {
455		$arc->{key}{$k} = $self->name;
456	}
457}
458
459sub alias
460{
461	my ($self, $arc, $alias) = @_;
462
463	my $k = $self->{archive}.":".$self->{archive}{cachename};
464	if (!defined $arc->{key}{$k}) {
465		$arc->{key}{$k} = $alias;
466	}
467}
468
469sub write_contents
470{
471	# only files have anything to write
472}
473
474sub resolve_links
475{
476	# only hard links must cheat
477}
478
479sub copy_contents
480{
481	# only files need copying
482}
483
484sub copy
485{
486	my ($self, $wrarc) = @_;
487	my $out = $wrarc->{fh};
488	$self->resolve_links($wrarc);
489	$wrarc->{padout} = 1;
490	my $header = $wrarc->mkheader($self, $self->type);
491	print $out $header or $self->fatal("Error writing to archive: #1", $!);
492
493	$self->copy_contents($wrarc);
494}
495
496sub isDir() { 0 }
497sub isFile() { 0 }
498sub isDevice() { 0 }
499sub isFifo() { 0 }
500sub isLink() { 0 }
501sub isSymLink() { 0 }
502sub isHardLink() { 0 }
503
504package OpenBSD::Ustar::Dir;
505our @ISA=qw(OpenBSD::Ustar::Object);
506
507sub create
508{
509	my $self = shift;
510	$self->ensure_dir($self->{destdir}.$self->name);
511	$self->set_modes;
512}
513
514sub isDir() { 1 }
515
516sub type() { OpenBSD::Ustar::DIR }
517
518package OpenBSD::Ustar::HardLink;
519our @ISA=qw(OpenBSD::Ustar::Object);
520
521sub create
522{
523	my $self = shift;
524	$self->make_basedir;
525	my $linkname = $self->{linkname};
526	if (defined $self->{cwd}) {
527		$linkname=$self->{cwd}.'/'.$linkname;
528	}
529	link $self->{destdir}.$linkname, $self->{destdir}.$self->name or
530	    $self->fatal("Can't link #1#2 to #1#3: #4",
531	    	$self->{destdir}, $linkname, $self->name, $!);
532}
533
534sub resolve_links
535{
536	my ($self, $arc) = @_;
537
538	my $k = $self->{archive}.":".$self->{linkname};
539	if (defined $arc->{key}{$k}) {
540		$self->{linkname} = $arc->{key}{$k};
541	} else {
542		print join("\n", keys(%{$arc->{key}})), "\n";
543		$self->fatal("Can't copy link over: original for #1 NOT available", $k);
544	}
545}
546
547sub isLink() { 1 }
548sub isHardLink() { 1 }
549
550sub type() { OpenBSD::Ustar::HARDLINK }
551
552package OpenBSD::Ustar::SoftLink;
553our @ISA=qw(OpenBSD::Ustar::Object);
554
555sub create
556{
557	my $self = shift;
558	$self->make_basedir;
559	symlink $self->{linkname}, $self->{destdir}.$self->name or
560	    $self->fatal("Can't symlink #1 to #2#3: #4",
561	    	$self->{linkname}, $self->{destdir}, $self->name, $!);
562	require POSIX;
563	POSIX::lchown($self->{uid}, $self->{gid}, $self->{destdir}.$self->name);
564}
565
566sub isLink() { 1 }
567sub isSymLink() { 1 }
568
569sub type() { OpenBSD::Ustar::SOFTLINK }
570
571package OpenBSD::Ustar::Fifo;
572our @ISA=qw(OpenBSD::Ustar::Object);
573
574sub create
575{
576	my $self = shift;
577	$self->make_basedir;
578	require POSIX;
579	POSIX::mkfifo($self->{destdir}.$self->name, $self->{mode}) or
580	    $self->fatal("Can't create fifo #1#2: #3", $self->{destdir},
581	    	$self->name, $!);
582	$self->set_modes;
583}
584
585sub isFifo() { 1 }
586sub type() { OpenBSD::Ustar::FIFO }
587
588package OpenBSD::UStar::Device;
589our @ISA=qw(OpenBSD::Ustar::Object);
590
591sub create
592{
593	my $self = shift;
594	$self->make_basedir;
595	$self->system(OpenBSD::Paths->mknod,
596	    '-m', $self->{mode}, '--', $self->{destdir}.$self->name,
597	    $self->devicetype, $self->{major}, $self->{minor});
598	$self->set_modes;
599}
600
601sub isDevice() { 1 }
602
603package OpenBSD::Ustar::BlockDevice;
604our @ISA=qw(OpenBSD::Ustar::Device);
605
606sub type() { OpenBSD::Ustar::BLOCKDEVICE }
607sub devicetype() { 'b' }
608
609package OpenBSD::Ustar::CharDevice;
610our @ISA=qw(OpenBSD::Ustar::Device);
611
612sub type() { OpenBSD::Ustar::BLOCKDEVICE }
613sub devicetype() { 'c' }
614
615package OpenBSD::CompactWriter;
616
617use constant {
618	FH => 0,
619	BS => 1,
620	ZEROES => 2,
621	UNFINISHED => 3,
622};
623
624sub new
625{
626	my ($class, $fname) = @_;
627	open (my $out, '>', $fname) or return;
628	my $bs = (stat $out)[11];
629	my $zeroes;
630	if (defined $bs) {
631		$zeroes = "\x00"x$bs;
632	}
633	bless [ $out, $bs, $zeroes, 0 ], $class;
634}
635
636sub write
637{
638	my ($self, $buffer) = @_;
639	my ($fh, $bs, $zeroes, $e) = @$self;
640START:
641	if (defined $bs) {
642		for (my $i = 0; $i + $bs <= length($buffer); $i+= $bs) {
643			if (substr($buffer, $i, $bs) eq $zeroes) {
644				my $r = syswrite($fh, $buffer, $i);
645				unless (defined $r && $r == $i) {
646					return 0;
647				}
648				$i+=$bs;
649				my $seek_forward = $bs;
650				while (substr($buffer, $i, $bs) eq $zeroes) {
651					$i += $bs;
652					$seek_forward += $bs;
653				}
654				defined(sysseek($fh, $seek_forward, 1))
655				    or return 0;
656				$buffer = substr($buffer, $i);
657				if (length $buffer == 0) {
658					$self->[UNFINISHED] = 1;
659					return 1;
660				}
661				goto START;
662			}
663		}
664	}
665	$self->[UNFINISHED] = 0;
666	my $r = syswrite($fh, $buffer);
667	if (defined $r && $r == length $buffer) {
668		return 1;
669	} else {
670		return 0;
671	}
672}
673
674sub close
675{
676	my ($self) = @_;
677	if ($self->[UNFINISHED]) {
678		defined(sysseek($self->[FH], -1, 1)) or return 0;
679		defined(syswrite($self->[FH], "\0")) or return 0;
680	}
681	return 1;
682}
683
684package OpenBSD::Ustar::File;
685our @ISA=qw(OpenBSD::Ustar::Object);
686
687sub create
688{
689	my $self = shift;
690	$self->make_basedir;
691	my $buffer;
692	my $out = OpenBSD::CompactWriter->new($self->{destdir}.$self->name);
693	if (!defined $out) {
694		$self->fatal("Can't write to #1#2: #3", $self->{destdir},
695		    $self->name, $!);
696	}
697	my $toread = $self->{size};
698	if ($self->{partial}) {
699		$toread -= length($self->{partial});
700		unless ($out->write($self->{partial})) {
701			$self->fatal("Error writing to #1#2: #3",
702			    $self->{destdir}, $self->name, $!);
703		}
704	}
705	while ($toread > 0) {
706		my $maxread = $buffsize;
707		$maxread = $toread if $maxread > $toread;
708		my $actual = read($self->{archive}{fh}, $buffer, $maxread);
709		if (!defined $actual) {
710			$self->fatal("Error reading from archive: #1", $!);
711		}
712		if ($actual == 0) {
713			$self->fatal("Premature end of archive");
714		}
715		$self->{archive}{swallow} -= $actual;
716		unless ($out->write($buffer)) {
717			$self->fatal("Error writing to #1#2: #3",
718			    $self->{destdir}, $self->name, $!);
719		}
720
721		$toread -= $actual;
722		$self->todo($toread);
723	}
724	$out->close or $self->fatal("Error closing #1#2: #3",
725	    $self->{destdir}, $self->name, $!);
726	$self->set_modes;
727}
728
729sub contents
730{
731	my ($self, $lookfor) = @_;
732	my $toread = $self->{size};
733	my $buffer;
734	my $offset = 0;
735	if ($self->{partial}) {
736		$buffer = $self->{partial};
737		$offset = length($self->{partial});
738		$toread -= $offset;
739	}
740
741	while ($toread != 0) {
742		my $sz = $toread;
743		if (defined $lookfor) {
744			last if (defined $buffer) and &$lookfor($buffer);
745			$sz = 1024 if $sz > 1024;
746		}
747		my $actual = read($self->{archive}{fh}, $buffer, $sz, $offset);
748		if (!defined $actual) {
749			$self->fatal("Error reading from archive: #1", $!);
750		}
751		if ($actual != $sz) {
752			$self->fatal("Error: short read from archive");
753		}
754		$self->{archive}{swallow} -= $actual;
755		$toread -= $actual;
756		$offset += $actual;
757	}
758
759	$self->{partial} = $buffer;
760	return $buffer;
761}
762
763sub write_contents
764{
765	my ($self, $arc) = @_;
766	my $filename = $self->{realname};
767	my $size = $self->{size};
768	my $out = $arc->{fh};
769	open my $fh, "<", $filename or $self->fatal("Can't read file #1: #2",
770	    $filename, $!);
771
772	my $buffer;
773	my $toread = $size;
774	while ($toread > 0) {
775		my $maxread = $buffsize;
776		$maxread = $toread if $maxread > $toread;
777		my $actual = read($fh, $buffer, $maxread);
778		if (!defined $actual) {
779			$self->fatal("Error reading from file: #1", $!);
780		}
781		if ($actual == 0) {
782			$self->fatal("Premature end of file");
783		}
784		unless (print $out $buffer) {
785			$self->fatal("Error writing to archive: #1", $!);
786		}
787
788		$toread -= $actual;
789		$self->todo($toread);
790	}
791	if ($size % 512) {
792		print $out "\0" x (512 - $size % 512) or
793		    $self->fatal("Error writing to archive: #1", $!);
794	}
795}
796
797sub copy_contents
798{
799	my ($self, $arc) = @_;
800	my $out = $arc->{fh};
801	my $buffer;
802	my $size = $self->{size};
803	my $toread = $size;
804	while ($toread > 0) {
805		my $maxread = $buffsize;
806		$maxread = $toread if $maxread > $toread;
807		my $actual = read($self->{archive}{fh}, $buffer, $maxread);
808		if (!defined $actual) {
809			$self->fatal("Error reading from archive: #1", $!);
810		}
811		if ($actual == 0) {
812			$self->fatal("Premature end of archive");
813		}
814		$self->{archive}{swallow} -= $actual;
815		unless (print $out $buffer) {
816			$self->fatal("Error writing to archive #1", $!);
817		}
818
819		$toread -= $actual;
820	}
821	if ($size % 512) {
822		print $out "\0" x (512 - $size % 512) or
823		    $self->fatal("Error writing to archive: #1", $!);
824	}
825	$self->alias($arc, $self->name);
826}
827
828sub isFile() { 1 }
829
830sub type() { OpenBSD::Ustar::FILE1 }
831
8321;
833