2 * Copyright (c) Zmanda, Inc. All Rights Reserved.
4 * This library is free software; you can redistribute it and/or modify it
5 * under the terms of the GNU Lesser General Public License version 2.1
6 * as published by the Free Software Foundation.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
11 * License for more details.
13 * You should have received a copy of the GNU Lesser General Public License
14 * along with this library; if not, write to the Free Software Foundation,
15 * Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
17 * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
18 * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
21 %module "Amanda::Archive"
22 %include "amglue/amglue.swg"
23 %include "exception.i"
33 Amanda::Archive - Perl access to the amanda archive library
39 # Write to the file descriptor $fd, and add /etc/hosts to it
40 my $archive = Amanda::Archive->new($fd, ">");
41 my $file = $archive->new_file("/etc/hosts");
42 my $attr = $file->new_attr(16);
43 open(my $fh, "<", "/etc/hosts");
44 $attr->add_data_fd(fileno($fh), 1);
48 # Read from an archive
49 my $archive = Amanda::Archive->new($fd, "<");
52 my ($user_data, $filenum, $filename) = @_;
54 return "foo"; # this becomes $file_data
57 my ($user_data, $file_data, $filenum, $truncated) = @_;
60 21 => [ 32768, # buffer into 32k chunks
62 my ($user_data, $filenum, $file_data, $attrid,
63 $attr_data, $data, $eoa, $truncated) = @_;
64 return "pants"; # becomes the new $attr_data for
65 # any subsequent fragments
67 0 => sub { # note no buffering here; attrid 0 is "default"
68 my ($user_data, $filenum, $file_data, $attrid,
69 $attr_data, $data, $eoa, $truncated) = @_;
70 return "shorts"; # becomes the new $attr_data for
71 # any subsequent fragments
73 user_data => [ "mydata" ], # sent to all callbacks
78 =head2 Amanda::Archive::Archive Objects
80 Note that C<Amanda::Archive->new> and C<Amanda::Archive::Archive->new> are
85 =item C<new($fd, $mode)>
87 Create a new archive for reading ("<") or writing (">") from or to file
90 =item C<new_file($filename, $want_posn)>
92 Create a new C<Amanda::Archive::File> object with the given filename (writing
95 Amanda::Archive::File->new($archive, $filename, $want_posn);
97 if C<$want_posn> is false, then this method returns a new
98 C<Amanda::Archive::File> object. If C<$want_posn> is true, then it returns
99 C<($file, $posn)> where C<$file> is the object and C<$posn> is the offset into
100 the datastream at which this file begins. This offset can be stored in an
101 index and used later to seek into the file.
105 See I<READING>, below.
109 Flush all buffers and close this archive. This does not close the file descriptor.
113 =head2 Amanda::Archive::File Objects
117 =item C<new($archive, $filename, $want_posn)>
119 Create a new file in the given archive. See C<Amanda::Archive::Archive::new_file>, above.
121 =item C<new_attr($attrid)>
123 Create a new C<Amanda::Archive::Attribute> object. Equivalent to
125 Amanda::Archive::Attr->new($file, $attrid);
129 Close this file, writing an EOF record.
133 =head2 Amanda::Archive::Attribute Objects
137 =item C<add_data($data, $eoa)>
139 Add C<$data> to this attribute, adding an EOA (end-of-attribute) bit if C<$eoa> is true.
141 =item C<add_data_fd($fd, $eoa)>
143 Copy data from C<$fd> to this attribute, adding an EOA (end-of-attribute) bit if C<$eoa> is true.
147 Close this attribute, adding an EOA bit if none has been written already.
153 The C<Amanda::Archive::Archive> method C<read()> handles reading archives via a callback mechanism. It takes its arguments in hash form, with the following keys:
156 my ($user_data, $filenum, $filename) = @_;
160 C<file_start> gives a sub which is called for every file in the archive. It
161 can return an arbitrary value which will become the C<$file_data> for
162 subsequent callbacks in this file, or the string "IGNORE" which will cause the
163 reader to ignore all data for this file. In this case, no other callbacks will
164 be made for the file (not even C<file_finish>).
167 my ($user_data, $file_data, $filenum, $truncated) = @_;
171 C<file_finish> gives a sub which is called when an EOF record appears.
172 C<$file_data> comes from the return value of the C<file_start> callback.
173 C<$truncated> is true if the file may be missing data (e.g., when an early EOF
176 user_data => $my_object,
178 C<user_data> gives an arbitrary value which is passed to each callback as C<$user_data>.
181 my ($user_data, $filenum, $file_data, $attrid,
182 $attr_data, $data, $eoa, $truncated) = @_;
185 19 => [ 10240, sub { ... } ],
187 Any numeric key is treated as an attribute ID, and specifies the handling for
188 that attribute. Attribute ID zero is treated as a wildcard, and will match any
189 attribute without an explicit handler. The handler can be specified as a sub
190 (as for attribute ID 13 in the example above) or as an arrayref C<[$minsize,
191 $sub]>. In the latter case, the sub is only called when at least C<$minsize>
192 bytes of data are available for the attribute, or at the end of the attribute
195 The parameters to the callback include C<$file_data>, the value returned from
196 C<file_start>, and C<$attr_data>, which is the return value of the last
197 invocation of this sub for this attribute. If this is the last fragment of
198 data for this attribute, then C<$eoa> is true. The meaning of C<$truncated>
199 is similar to that in C<file_finish>.
204 my ($arch_fh, $basedir) = @_;
206 my $arch = Amanda::Archive->new(fileno($arch_fh), "<");
209 my ($user_data, $filenum, $filename) = @_;
210 return "$basedir/$filenum"; # becomes $file_data
213 my ($user_data, $filenum, $file_data, $attrid,
214 $attr_data, $data, $eoa, $truncated) = @_;
215 warn("file $filename attribute $attrid is truncated")
217 # store the open filehandle in $attr_data
219 open($attr_data, "$file_data.$attrid", ">")
222 print $attr_data $data;
235 /* Support code (not directly available from perl) */
237 /* A C object to contain all of the relevant callbacks and other state during a
238 * read operation; this becomes the user_data during the read */
239 typedef struct perl_read_data_s {
244 amar_attr_handling_t *handling_array;
257 perl_read_data_t *dat = user_data;
264 g_assert(dat->file_start_sub != NULL);
270 XPUSHs(dat->user_data);
271 XPUSHs(sv_2mortal(newSViv(filenum)));
272 XPUSHs(sv_2mortal(newSVpvn(filename, filename_len)));
275 count = call_sv(dat->file_start_sub, G_EVAL|G_SCALAR);
280 croak("file_start_sub returned nothing");
284 /* if it's the string "IGNORE", then ignore it */
286 static const char *ign = "IGNORE";
287 char *rvstr = SvPV(rv, len);
288 if (strlen(ign) == len && 0 == strncmp(ign, rvstr, len))
292 /* otherwise, keep the value */
294 *(SV **)(file_data) = SvREFCNT_inc(rv);
313 perl_read_data_t *dat = user_data;
315 g_assert(dat->file_finish_sub != NULL);
320 PUSHMARK(SP); XPUSHs(dat->user_data); XPUSHs(*(SV **)file_data);
321 XPUSHs(sv_2mortal(newSViv(filenum)));
322 XPUSHs(sv_2mortal(newSViv(truncated))); PUTBACK;
324 call_sv(dat->file_finish_sub, G_EVAL|G_DISCARD);
326 /* we're done with this file's file_data */
327 SvREFCNT_dec(*(SV **)file_data);
343 gpointer attrid_data,
351 perl_read_data_t *dat = user_data;
362 XPUSHs(dat->user_data);
363 XPUSHs(sv_2mortal(newSViv(filenum)));
364 XPUSHs((SV *)file_data);
365 XPUSHs(sv_2mortal(newSViv(attrid)));
367 XPUSHs((SV *)(*attr_data));
369 XPUSHs(&PL_sv_undef);
370 XPUSHs(sv_2mortal(newSVpvn(data, size)));
371 XPUSHs(sv_2mortal(newSViv(eoa)));
372 XPUSHs(sv_2mortal(newSViv(truncated)));
375 count = call_sv(attrid_data, G_EVAL|G_SCALAR);
380 croak("fragment callback returned nothing");
385 SvREFCNT_dec(*attr_data);
387 /* increment before decrement here, in case they're the same object */
389 SvREFCNT_dec(*attr_data);
402 croak_gerror(GError **error)
404 static char *errstr = NULL;
405 if (errstr) g_free(errstr);
406 errstr = g_strdup((*error)->message);
407 g_clear_error(error);
408 croak("Amanda archive: %s", errstr);
411 /* generic function to recognize when a string+len represents a number and
412 * incidentally return the resulting value. Note that this does not handle
413 * negative numbers. */
415 is_number(char *str, int len, int *result)
421 if (!g_ascii_isdigit(*str)) return FALSE;
422 r = r * 10 + (int)(*str - '0');
436 /* Rename all of the below wrapper functions (suffixed with '_') for
437 * consumption by perl */
438 %rename(amar_new) amar_new_;
439 %rename(amar_close) amar_close_;
440 %rename(amar_new_file) amar_new_file_;
441 %rename(amar_file_close) amar_file_close_;
442 %rename(amar_new_attr) amar_new_attr_;
443 %rename(amar_attr_close) amar_attr_close_;
444 %rename(amar_attr_add_data_buffer) amar_attr_add_data_buffer_;
445 %rename(amar_attr_add_data_fd) amar_attr_add_data_fd_;
446 %rename(amar_read) amar_read_;
448 /* typemaps for the below */
449 %apply (char *STRING, int LENGTH) { (char *filename, gsize filename_len) };
450 %apply (char *STRING, int LENGTH) { (char *buffer, gsize size) };
451 %typemap(in) SV * "$1 = $input;"
453 %typemap(in) off_t *want_position (off_t position) {
454 if (SvTRUE($input)) {
461 %typemap(argout) off_t *want_position {
463 $result = amglue_newSVi64(*$1);
470 /* Wrapper functions, mostly dealing with error handling */
472 amar_t *amar_new_(int fd, char *modestr) {
473 GError *error = NULL;
477 if (strcmp(modestr, ">") == 0)
479 else if (strcmp(modestr, "<") == 0)
482 croak("mode must be '<' or '>'");
484 if ((rv = amar_new(fd, mode, &error))) {
488 croak_gerror(&error);
492 void amar_close_(amar_t *arch) {
493 GError *error = NULL;
494 if (!amar_close(arch, &error))
495 croak_gerror(&error);
499 amar_new_file_(amar_t *arch, char *filename, gsize filename_len, off_t *want_position) {
500 GError *error = NULL;
502 g_assert(arch != NULL);
504 file = amar_new_file(arch, filename, filename_len, want_position, &error);
508 croak_gerror(&error);
512 void amar_file_close_(amar_file_t *file) {
513 GError *error = NULL;
514 if (!amar_file_close(file, &error))
515 croak_gerror(&error);
519 amar_new_attr_(amar_file_t *file, guint16 attrid) {
520 GError *error = NULL;
523 g_assert(file != NULL);
525 attr = amar_new_attr(file, attrid, &error);
529 croak_gerror(&error);
533 void amar_attr_close_(amar_attr_t *attr) {
534 GError *error = NULL;
535 if (!amar_attr_close(attr, &error))
536 croak_gerror(&error);
539 void amar_attr_add_data_buffer_(amar_attr_t *attr, char *buffer, gsize size, gboolean eoa) {
540 GError *error = NULL;
541 if (!amar_attr_add_data_buffer(attr, buffer, size, eoa, &error))
542 croak_gerror(&error);
546 amar_attr_add_data_fd_(amar_attr_t *attr, int fd, gboolean eoa) {
547 GError *error = NULL;
548 size_t rv = amar_attr_add_data_fd(attr, fd, eoa, &error);
550 croak_gerror(&error);
556 void amar_read_(amar_t *archive, SV *params_hashref) {
557 perl_read_data_t *dat = g_new0(perl_read_data_t, 1);
558 GError *error = NULL;
566 /* make sure we got a hashref */
567 if (!SvROK(params_hashref) || SvTYPE(SvRV(params_hashref)) != SVt_PVHV)
568 croak("read() expects a single hashref");
569 params = (HV *)SvRV(params_hashref);
570 len = hv_iterinit(params);
572 maxhandlers = hdl_idx = len;
573 dat->handling_array = g_new0(amar_attr_handling_t, len+1);
575 /* loop through the parameters */
576 while ((param = hv_iternext(params))) {
578 char *key = hv_iterkey(param, &keylen);
581 /* if it's a number, it's handling information for an attrid */
582 if (is_number(key, keylen, &attrid)) {
583 SV *val = hv_iterval(params, param);
588 if (!SvROK(val)) goto croak_hdl;
590 switch (SvTYPE(SvRV(val))) {
596 AV *arr = (AV *)SvRV(val);
599 if (av_len(arr) != 1) /* av_len == largest index, not length */
602 /* get the bufsize */
603 svp = av_fetch(arr, 0, 0);
606 bufsize = SvUV(*svp);
608 /* and the coderef */
609 svp = av_fetch(arr, 1, 0);
610 if (!SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVCV)
620 /* fill in the handling array, putting attrid 0 at the end, and
621 * filling in entries backward from there */
622 i = (attrid == 0)? maxhandlers : --hdl_idx;
623 dat->handling_array[i].attrid = attrid;
624 dat->handling_array[i].min_size = bufsize;
625 dat->handling_array[i].callback = read_frag_cb;
626 dat->handling_array[i].attrid_data = coderef;
627 SvREFCNT_inc(coderef);
631 croak("Expected CODEREF or [ MIN_SIZE, CODEREF ] for attrid %d", attrid);
634 #define key_compare(key, val, keylen) \
635 (keylen == sizeof(val)-1) && (0 == strncmp(key, val, keylen))
637 if (key_compare(key, "file_start", keylen)) {
638 SV *val = hv_iterval(params, param);
639 if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVCV)
640 croak("Expected a CODEREF for file_start");
641 dat->file_start_sub = val;
646 if (key_compare(key, "file_finish", keylen)) {
647 SV *val = hv_iterval(params, param);
648 if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVCV)
649 croak("Expected a CODEREF for file_finish");
650 dat->file_finish_sub = val;
655 if (key_compare(key, "user_data", keylen)) {
656 SV *val = hv_iterval(params, param);
657 dat->user_data = val;
662 croak("Invalid parameter named '%*s'", (int)keylen, key);
666 dat->user_data = &PL_sv_undef;
668 success = amar_read(archive, dat, dat->handling_array + hdl_idx,
669 dat->file_start_sub? read_start_file_cb : NULL,
670 dat->file_finish_sub? read_finish_file_cb : NULL,
673 /* now unreference and free everything we referenced earlier */
674 if (dat->file_start_sub)
675 SvREFCNT_dec(dat->file_start_sub);
676 if (dat->file_finish_sub)
677 SvREFCNT_dec(dat->file_finish_sub);
678 if (dat->user_data && dat->user_data != &PL_sv_undef)
679 SvREFCNT_dec(dat->user_data);
681 for (hdl_idx = 0; hdl_idx <= maxhandlers; hdl_idx++) {
682 if (dat->handling_array[hdl_idx].attrid_data)
683 SvREFCNT_dec(dat->handling_array[hdl_idx].attrid_data);
686 g_free(dat->handling_array);
689 /* if amar_read returned FALSE, then either we hit an internal
690 * error, or one of the perl callbacks raised an exception, and $@
694 croak_gerror(&error);
702 /* now wrap those flat functions in Perl classes, depending on the perl
703 * refcounting to close objects in the right order */
706 package Amanda::Archive;
708 # Expose the Archive constructor at Amanda::Archive->new
711 Amanda::Archive::Archive->new(@_);
714 package Amanda::Archive::Archive;
717 my ($class, $fd, $mode) = @_;
718 my $arch = Amanda::Archive::amar_new($fd, $mode);
719 return bless (\$arch, $class);
725 Amanda::Archive::amar_close($$self);
736 my ($self, $filename, $want_offset) = @_;
737 return Amanda::Archive::File->new($self, $filename, $want_offset);
740 sub Amanda::Archive::Archive::read {
742 die "Archive is not open" unless ($$self);
743 # pass a hashref to the C code
745 Amanda::Archive::amar_read($$self, \%h);
748 package Amanda::Archive::File;
751 my ($class, $arch, $filename, $want_offset) = @_;
752 die "Archive is not open" unless ($$arch);
754 # note that posn is returned first by the SWIG wrapper
755 my ($file, $posn) = Amanda::Archive::amar_new_file($$arch, $filename, $want_offset);
756 return (bless([ $file, $arch ], $class), $posn);
758 my $file = Amanda::Archive::amar_new_file($$arch, $filename, $want_offset);
759 return bless([ $file, $arch ], $class);
766 Amanda::Archive::amar_file_close($self->[0]);
777 my ($self, $attrid) = @_;
778 return Amanda::Archive::Attr->new($self, $attrid);
781 package Amanda::Archive::Attr;
784 my ($class, $file, $attrid) = @_;
785 die "File is not open" unless ($file->[0]);
786 my $attr = Amanda::Archive::amar_new_attr($file->[0], $attrid);
787 return bless ([$attr, $file], $class);
793 Amanda::Archive::amar_attr_close($self->[0]);
804 my ($self, $data, $eoa) = @_;
805 die "Attr is not open" unless ($self->[0]);
806 Amanda::Archive::amar_attr_add_data_buffer($self->[0], $data, $eoa);
810 my ($self, $fd, $eoa) = @_;
811 die "Attr is not open" unless ($self->[0]);
812 return Amanda::Archive::amar_attr_add_data_fd($self->[0], $fd, $eoa);