2 * Copyright (c) 2008-2012 Zmanda, Inc. All Rights Reserved.
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
19 * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
22 %module "Amanda::Xfer"
23 %include "amglue/amglue.swg"
24 %include "exception.i"
26 %import "Amanda/MainLoop.swg"
31 #include "glib-util.h"
34 #include "sockaddr-util.h"
37 /* The SWIGging of the transfer architecture.
39 * The C layer of the transfer architecture exposes some structs, which are
40 * arranged through GObject magic into a class hierarchy. It also exposes
41 * regular C functions which are intended to act as methods on these structs.
42 * Furthermore, it exposes Perl callbacks (via Amanda::MainLoop) with
43 * parameters involving objects of these classes.
45 * SWIG doesn't support callbacks very well, and makes it particularly
46 * difficult to represent a GObject class hierarchy. Rather than try to "make
47 * it fit" into SWIG, this module uses custom typemaps and perl/C conversions
48 * to get all of this stuff right in the first place.
50 * For Xfer objects, we define two functions, new_sv_for_xfer and xfer_from_sv,
51 * which create a new SV for an Xfer object, and subsequently extract a pointer
52 * to the object from the SV. The SV is both blessed and tied to the
53 * Amanda::Xfer::Xfer class, in which all of the method calls are defined, and
54 * which defines a DESTROY method that calls xfer_unref.
56 * XferElements are similar, but we have the added challenge of representing
57 * subclasses with appropriate perl subclasses. The solution is to tag each C
58 * class with a perl class name, and use that name when blessing a new SV.
60 * Finally, XMsgs are reflected entirely into perl hashrefs, in the interest of
69 /* We need GType and GThread initialized to use xfers */
77 amglue_add_enum_tag_fns(xfer_status);
78 amglue_add_constant(XFER_INIT, xfer_status);
79 amglue_add_constant(XFER_START, xfer_status);
80 amglue_add_constant(XFER_RUNNING, xfer_status);
81 amglue_add_constant(XFER_DONE, xfer_status);
82 amglue_copy_to_tag(xfer_status, constants);
84 amglue_add_enum_tag_fns(xmsg_type);
85 amglue_add_constant(XMSG_INFO, xmsg_type);
86 amglue_add_constant(XMSG_ERROR, xmsg_type);
87 amglue_add_constant(XMSG_DONE, xmsg_type);
88 amglue_add_constant(XMSG_CANCEL, xmsg_type);
89 amglue_add_constant(XMSG_PART_DONE, xmsg_type);
90 amglue_add_constant(XMSG_READY, xmsg_type);
91 amglue_copy_to_tag(xmsg_type, constants);
98 /* Given an XMsg, return a hashref representing the message as a pure-perl
99 * object. The object is new, has refcount 1, and is totally independent of
100 * the underlying XMsg.
102 * Reflecting the XMsg directly into Perl avoids the need to reference-count
103 * the XMsg objects themselves, which can simply be freed after a callback
104 * completes. The overhead of creating a hash is likely equivalent to or
105 * less than the overhead that would be consumed with SWIG's swig_$field_get
106 * accessors, assuming that perl code examines most of the fields in a message.
108 * @param msg: the message to represent
109 * @returns: a perl SV
115 static HV *amanda_xfer_msg_stash = NULL;
117 SV *rv = newRV_noinc((SV *)hash);
119 /* bless the rv as an Amanda::Xfer::Msg object */
120 if (!amanda_xfer_msg_stash) {
121 amanda_xfer_msg_stash = gv_stashpv("Amanda::Xfer::Msg", GV_ADD);
123 sv_bless(rv, amanda_xfer_msg_stash);
125 /* TODO: consider optimizing by precomputing the hash values of
129 hv_store(hash, "elt", 3, new_sv_for_xfer_element(msg->elt), 0);
132 hv_store(hash, "type", 4, newSViv(msg->type), 0);
135 hv_store(hash, "version", 7, newSViv(msg->version), 0);
139 hv_store(hash, "message", 7, newSVpv(msg->message, 0), 0);
142 hv_store(hash, "successful", 10, newSViv(msg->successful), 0);
145 hv_store(hash, "eom", 3, newSViv(msg->eom), 0);
148 hv_store(hash, "eof", 3, newSViv(msg->eof), 0);
151 hv_store(hash, "size", 4, amglue_newSVu64(msg->size), 0);
154 hv_store(hash, "duration", 8, newSVnv(msg->duration), 0);
157 hv_store(hash, "partnum", 7, amglue_newSVu64(msg->partnum), 0);
160 hv_store(hash, "fileno", 6, amglue_newSVu64(msg->fileno), 0);
166 %typemap(in) Xfer * {
167 $1 = xfer_from_sv($input);
170 %typemap(in) XferElement * {
171 $1 = xfer_element_from_sv($input);
174 %typemap(out) Xfer * {
175 $result = sv_2mortal(new_sv_for_xfer($1));
179 %typemap(out) XferElement * {
180 $result = sv_2mortal(new_sv_for_xfer_element($1));
184 %typemap(newfree) Xfer * {
188 %typemap(newfree) XferElement * {
189 xfer_element_unref($1);
196 /* A typemap for the input to the Xfer constructor, a.k.a. xfer_new */
197 %typemap(in,numinputs=1) (XferElement **elementlist, unsigned int nelements) {
201 /* check that it's an arrayref */
202 if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
203 SWIG_exception(SWIG_TypeError, "Expected an arrayref");
205 av = (AV *)SvRV($input);
207 /* allocate memory for $1 */
208 $2 = av_len(av)+1; /* av_len(av) is like $#av */
209 $1 = g_new(XferElement *, $2);
211 /* extract the underlying XferElement objects and add pointers to
212 * them, "borrowing" the caller's references for the moment. */
213 for (i = 0; i < $2; i++) {
214 SV **sv = av_fetch(av, i, 0);
215 XferElement *elt = sv? xfer_element_from_sv(*sv):NULL;
218 SWIG_exception(SWIG_TypeError, "Expected an arrayref of Amanda::Xfer::Element objects");
224 %typemap(freearg) (XferElement **elementlist, unsigned int nelements) {
225 /* free the element vector allocated in the (in) typemap */
230 Xfer *xfer_new(XferElement **elementlist, unsigned int nelements);
231 void xfer_unref(Xfer *);
232 xfer_status xfer_get_status(Xfer *xfer);
233 char *xfer_repr(Xfer *xfer);
234 void xfer_start(Xfer *xfer, gint64 offset, gint64 size);
235 void xfer_cancel(Xfer *xfer);
236 /* xfer_get_source is implemented below */
239 /* SWIG wants to treat this as a function */
240 #define xfer_get_status(xfer) ((xfer)->status)
243 /* upgrade the start method to optionally take a callback, which is
244 * passed to the GSource's set_callback */
246 sub xfer_start_with_callback {
247 my ($xfer, $cb, $offset, $size) = @_;
249 my $releasing_cb = sub {
250 my ($src, $msg, $xfer) = @_;
251 my $done = $msg->{'type'} == $XMSG_DONE;
252 $src->remove() if $done;
254 $cb = undef if $done; # break potential reference loop
256 $xfer->get_source()->set_callback($releasing_cb);
258 $offset = 0 if !defined $offset;
259 $size = 0 if !defined $size;
260 xfer_start($xfer, $offset, $size);
264 /* Change the callback */
266 sub xfer_set_callback {
267 my ($xfer, $cb) = @_;
269 my $releasing_cb = sub {
270 my ($src, $msg, $xfer) = @_;
271 my $done = $msg->{'type'} == $XMSG_DONE;
272 $src->remove() if $done;
274 $cb = undef if $done; # break potential reference loop
276 $xfer->get_source()->set_callback($releasing_cb);
278 $xfer->get_source()->set_callback(undef);
284 * XferElement functions
286 * Some of these methods are not intended to be used from Perl; they are annotated
290 void xfer_element_unref(XferElement *elt); /* (wrap the macro, above) */
291 /* xfer_element_link_to -- private */
292 char *xfer_element_repr(XferElement *elt);
293 /* xfer_element_set_size -- private */
294 /* xfer_element_start -- private */
295 /* xfer_element_cancel -- private */
298 static gboolean same_elements(
306 /* subclass constructors */
308 /* N.B. When adding new classes, ensure that the class_init function
309 * sets perl_class to the appropriate value. */
311 %newobject xfer_source_random;
312 XferElement *xfer_source_random(
316 guint32 xfer_source_random_get_seed(
319 %typemap(in) (void * pattern, size_t pattern_length) {
323 pat = SvPV($input, len);
324 $1 = g_memdup(pat, len);
328 %typemap(in) (gchar **argv) {
333 /* check that it's an arrayref */
334 if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
335 SWIG_exception(SWIG_TypeError, "Expected a non-empty arrayref");
337 av = (AV *)SvRV($input);
339 /* allocate memory for $1 */
340 len = av_len(av)+1; /* av_len(av) is like $#av */
342 SWIG_exception(SWIG_TypeError, "Expected a non-empty arrayref");
344 $1 = g_new0(gchar *, len+1);
346 for (i = 0; i < len; i++) {
347 SV **sv = av_fetch(av, i, 0);
348 g_assert(sv != NULL);
349 $1[i] = g_strdup(SvPV_nolen(*sv));
352 /* final element is already NULL due to g_new0; xfer_filter_process takes
353 * care of freeing this array, so we don't have to */
356 %newobject xfer_source_pattern;
357 XferElement *xfer_source_pattern(
360 size_t pattern_length);
362 %newobject xfer_source_fd;
363 XferElement *xfer_source_fd(
366 %newobject xfer_source_directtcp_listen;
367 XferElement *xfer_source_directtcp_listen(void);
370 static DirectTCPAddr *
371 xfer_source_directtcp_listen_get_addrs(XferElement *elt) {
372 return elt->input_listen_addrs;
376 %newobject xfer_source_directtcp_connect;
377 XferElement *xfer_source_directtcp_connect(DirectTCPAddr *addrs);
379 %newobject xfer_filter_xor;
380 XferElement *xfer_filter_xor(
381 unsigned char xor_key);
383 %newobject xfer_filter_process;
384 XferElement *xfer_filter_process(
390 %newobject xfer_dest_null;
391 XferElement *xfer_dest_null(
394 %newobject xfer_dest_buffer;
395 XferElement *xfer_dest_buffer(
398 %cstring_output_allocate_size(gpointer *buf, gsize *size, );
399 void xfer_dest_buffer_get(
404 %newobject xfer_dest_fd;
405 XferElement *xfer_dest_fd(
408 %newobject xfer_dest_directtcp_listen;
409 XferElement *xfer_dest_directtcp_listen(void);
412 static DirectTCPAddr *
413 xfer_dest_directtcp_listen_get_addrs(XferElement *elt) {
414 return elt->output_listen_addrs;
418 %newobject xfer_dest_directtcp_connect;
419 XferElement *xfer_dest_directtcp_connect(DirectTCPAddr *addrs);
425 %types(amglue_Source *);
428 xmsgsource_perl_callback(
434 amglue_Source *src = (amglue_Source *)data;
439 /* keep the source around long enough for the call to finish */
440 amglue_source_ref(src);
441 g_assert(src->callback_sv != NULL);
446 /* create a new SV pointing to 'src', and increase its refcount
448 amglue_source_ref(src);
449 src_sv = SWIG_NewPointerObj(src, SWIGTYPE_p_amglue_Source,
450 SWIG_OWNER | SWIG_SHADOW);
451 SvREFCNT_inc(src_sv);
453 msg_sv = new_sv_for_xmsg(msg);
454 xfer_sv = new_sv_for_xfer(xfer);
457 XPUSHs(sv_2mortal(src_sv));
458 XPUSHs(sv_2mortal(msg_sv));
459 XPUSHs(sv_2mortal(xfer_sv));
462 call_sv(src->callback_sv, G_EVAL|G_DISCARD);
467 /* we no longer need the src */
468 amglue_source_unref(src);
471 /* these may be gone, so NULL them out */
476 /* check for an uncaught 'die'. If we don't do this, then Perl will longjmp()
477 * over the GMainLoop mechanics, leaving GMainLoop in an inconsistent (locked)
480 /* We handle this just the way the default 'die' handler in Amanda::Debug
481 * does, but since Amanda's debug support may not yet be running, we back
482 * it up with an exit() */
483 g_critical("%s", SvPV_nolen(ERRSV));
491 %newobject xfer_get_amglue_source;
494 xfer_get_amglue_source(
497 return amglue_source_get(xfer_get_source(xfer),
498 (GSourceFunc)xmsgsource_perl_callback);
503 * XMsg and XMsgSource handling
510 /* First, a few macros to generate decent Perl */
518 %define XFER_ELEMENT_SUBCLASS_OF(PARENT)
525 %define XFER_ELEMENT_SUBCLASS()
526 XFER_ELEMENT_SUBCLASS_OF(Amanda::Xfer::Element)
529 %define DECLARE_CONSTRUCTOR(C_CONSTRUCTOR)
533 # The C function adds the proper blessing -- this function
534 # just gets $pkg out of the way.
540 %define OVERLOAD_REPR()
542 use overload '""' => sub { $_[0]->repr(); };
543 # overload comparison, so users can ask if one obj == another
544 use overload '==' => sub { Amanda::Xfer::same_elements($_[0], $_[1]); };
545 use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); };
549 %define DECLARE_METHOD(METHOD_NAME, C_FUNCTION)
550 %perlcode {*METHOD_NAME = *C_FUNCTION;
554 /* And now define the required perl classes */
556 PACKAGE(Amanda::Xfer::Xfer)
557 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_new);
558 DECLARE_METHOD(DESTROY, Amanda::Xfer::xfer_unref);
560 DECLARE_METHOD(repr, Amanda::Xfer::xfer_repr);
561 DECLARE_METHOD(get_status, Amanda::Xfer::xfer_get_status);
562 DECLARE_METHOD(get_source, Amanda::Xfer::xfer_get_amglue_source);
563 DECLARE_METHOD(start, Amanda::Xfer::xfer_start_with_callback);
564 DECLARE_METHOD(set_callback, Amanda::Xfer::xfer_set_callback);
565 DECLARE_METHOD(cancel, Amanda::Xfer::xfer_cancel);
569 PACKAGE(Amanda::Xfer::Element)
570 DECLARE_METHOD(DESTROY, Amanda::Xfer::xfer_element_unref);
572 DECLARE_METHOD(repr, Amanda::Xfer::xfer_element_repr);
576 PACKAGE(Amanda::Xfer::Element::Glue)
577 XFER_ELEMENT_SUBCLASS()
578 /* no constructor -- internal use only */
582 PACKAGE(Amanda::Xfer::Source::Fd)
583 XFER_ELEMENT_SUBCLASS()
584 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_fd)
588 PACKAGE(Amanda::Xfer::Source::Random)
589 XFER_ELEMENT_SUBCLASS()
590 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_random)
591 DECLARE_METHOD(get_seed, Amanda::Xfer::xfer_source_random_get_seed)
595 PACKAGE(Amanda::Xfer::Source::DirectTCPListen)
596 XFER_ELEMENT_SUBCLASS()
597 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_directtcp_listen)
598 DECLARE_METHOD(get_addrs, Amanda::Xfer::xfer_source_directtcp_listen_get_addrs)
602 PACKAGE(Amanda::Xfer::Source::DirectTCPConnect)
603 XFER_ELEMENT_SUBCLASS()
604 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_directtcp_connect)
608 PACKAGE(Amanda::Xfer::Source::Pattern)
609 XFER_ELEMENT_SUBCLASS()
610 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_pattern)
614 PACKAGE(Amanda::Xfer::Filter::Xor)
615 XFER_ELEMENT_SUBCLASS()
616 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_filter_xor)
620 PACKAGE(Amanda::Xfer::Filter::Process)
621 XFER_ELEMENT_SUBCLASS()
622 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_filter_process)
623 DECLARE_METHOD(get_stderr_fd, Amanda::Xfer::get_err_fd)
627 PACKAGE(Amanda::Xfer::Dest::Fd)
628 XFER_ELEMENT_SUBCLASS()
629 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_fd)
633 PACKAGE(Amanda::Xfer::Dest::Null)
634 XFER_ELEMENT_SUBCLASS()
635 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_null)
639 PACKAGE(Amanda::Xfer::Dest::Buffer)
640 XFER_ELEMENT_SUBCLASS()
641 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_buffer)
642 DECLARE_METHOD(get, Amanda::Xfer::xfer_dest_buffer_get)
646 PACKAGE(Amanda::Xfer::Dest::DirectTCPListen)
647 XFER_ELEMENT_SUBCLASS()
648 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_directtcp_listen)
649 DECLARE_METHOD(get_addrs, Amanda::Xfer::xfer_dest_directtcp_listen_get_addrs)
653 PACKAGE(Amanda::Xfer::Dest::DirectTCPConnect)
654 XFER_ELEMENT_SUBCLASS()
655 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_directtcp_connect)
659 PACKAGE(Amanda::Xfer::Msg)
662 use overload '""' => sub { $_[0]->repr(); };
666 local $Data::Dumper::Indent = 0;
667 local $Data::Dumper::Terse = 1;
668 local $Data::Dumper::Useqq = 1;
670 my $typestr = Amanda::Xfer::xmsg_type_to_string($self->{'type'});
671 my $str = "{ type => \$$typestr, elt => $self->{'elt'}, version => $self->{'version'},";
673 my %skip = ( "type" => 1, "elt" => 1, "version" => 1 );
674 for my $k (keys %$self) {
676 $str .= " $k => " . Dumper($self->{$k}) . ",";
679 # strip the trailing comma and add a closing brace
688 PACKAGE(Amanda::Xfer)
690 # make Amanda::Xfer->new equivalent to Amanda::Xfer::Xfer->new (don't
691 # worry, the blessings work out just fine)
692 *new = *Amanda::Xfer::Xfer::new;
694 # try to load Amanda::XferServer, which is server-only. If it's not found, then
695 # its classes just remain undefined.
698 if (Amanda::Util::built_with_component("server")) {
699 eval "use Amanda::XferServer;";