1# This file was automatically generated by SWIG (http://www.swig.org). 2# Version 3.0.7 3# 4# Do not make changes to this file unless you know what you are doing--modify 5# the SWIG interface file instead. 6 7package Amanda::Xfer; 8use base qw(Exporter); 9use base qw(DynaLoader); 10require Amanda::MainLoop; 11package Amanda::Xferc; 12bootstrap Amanda::Xfer; 13package Amanda::Xfer; 14@EXPORT = qw(); 15 16# ---------- BASE METHODS ------------- 17 18package Amanda::Xfer; 19 20sub TIEHASH { 21 my ($classname,$obj) = @_; 22 return bless $obj, $classname; 23} 24 25sub CLEAR { } 26 27sub FIRSTKEY { } 28 29sub NEXTKEY { } 30 31sub FETCH { 32 my ($self,$field) = @_; 33 my $member_func = "swig_${field}_get"; 34 $self->$member_func(); 35} 36 37sub STORE { 38 my ($self,$field,$newval) = @_; 39 my $member_func = "swig_${field}_set"; 40 $self->$member_func($newval); 41} 42 43sub this { 44 my $ptr = shift; 45 return tied(%$ptr); 46} 47 48 49# ------- FUNCTION WRAPPERS -------- 50 51package Amanda::Xfer; 52 53*xfer_new = *Amanda::Xferc::xfer_new; 54*xfer_unref = *Amanda::Xferc::xfer_unref; 55*xfer_get_status = *Amanda::Xferc::xfer_get_status; 56*xfer_repr = *Amanda::Xferc::xfer_repr; 57*xfer_start = *Amanda::Xferc::xfer_start; 58*xfer_cancel = *Amanda::Xferc::xfer_cancel; 59*xfer_element_unref = *Amanda::Xferc::xfer_element_unref; 60*xfer_element_repr = *Amanda::Xferc::xfer_element_repr; 61*same_elements = *Amanda::Xferc::same_elements; 62*xfer_source_random = *Amanda::Xferc::xfer_source_random; 63*xfer_source_random_get_seed = *Amanda::Xferc::xfer_source_random_get_seed; 64*xfer_source_pattern = *Amanda::Xferc::xfer_source_pattern; 65*xfer_source_fd = *Amanda::Xferc::xfer_source_fd; 66*xfer_source_directtcp_listen = *Amanda::Xferc::xfer_source_directtcp_listen; 67*xfer_source_directtcp_listen_get_addrs = *Amanda::Xferc::xfer_source_directtcp_listen_get_addrs; 68*xfer_source_directtcp_connect = *Amanda::Xferc::xfer_source_directtcp_connect; 69*xfer_filter_xor = *Amanda::Xferc::xfer_filter_xor; 70*xfer_filter_process = *Amanda::Xferc::xfer_filter_process; 71*get_err_fd = *Amanda::Xferc::get_err_fd; 72*xfer_dest_null = *Amanda::Xferc::xfer_dest_null; 73*xfer_dest_buffer = *Amanda::Xferc::xfer_dest_buffer; 74*xfer_dest_buffer_get = *Amanda::Xferc::xfer_dest_buffer_get; 75*xfer_dest_fd = *Amanda::Xferc::xfer_dest_fd; 76*xfer_dest_directtcp_listen = *Amanda::Xferc::xfer_dest_directtcp_listen; 77*xfer_dest_directtcp_listen_get_addrs = *Amanda::Xferc::xfer_dest_directtcp_listen_get_addrs; 78*xfer_dest_directtcp_connect = *Amanda::Xferc::xfer_dest_directtcp_connect; 79*xfer_get_amglue_source = *Amanda::Xferc::xfer_get_amglue_source; 80 81# ------- VARIABLE STUBS -------- 82 83package Amanda::Xfer; 84 85*XFER_INIT = *Amanda::Xferc::XFER_INIT; 86*XFER_START = *Amanda::Xferc::XFER_START; 87*XFER_RUNNING = *Amanda::Xferc::XFER_RUNNING; 88*XFER_DONE = *Amanda::Xferc::XFER_DONE; 89*XMSG_INFO = *Amanda::Xferc::XMSG_INFO; 90*XMSG_ERROR = *Amanda::Xferc::XMSG_ERROR; 91*XMSG_DONE = *Amanda::Xferc::XMSG_DONE; 92*XMSG_CANCEL = *Amanda::Xferc::XMSG_CANCEL; 93*XMSG_PART_DONE = *Amanda::Xferc::XMSG_PART_DONE; 94*XMSG_READY = *Amanda::Xferc::XMSG_READY; 95 96@EXPORT_OK = (); 97%EXPORT_TAGS = (); 98 99 100=head1 NAME 101 102Amanda::Xfer - the transfer architecture 103 104=head1 SYNOPSIS 105 106 use Amanda::MainLoop; 107 use Amanda::Xfer qw( :constants ); 108 use POSIX; 109 110 my $infd = POSIX::open("input", POSIX::O_RDONLY, 0); 111 my $outfd = POSIX::open("output", POSIX::O_CREAT|POSIX::O_WRONLY, 0640); 112 my $xfer = Amanda::Xfer->new([ 113 Amanda::Xfer::Source::Fd->new($infd), 114 Amanda::Xfer::Dest::Fd->new($outfd) 115 ]); 116 $xfer->start(sub { 117 my ($src, $xmsg, $xfer) = @_; 118 print "Message from $xfer: $xmsg\n"; # use stringify operations 119 if ($msg->{'type'} == $XMSG_DONE) { 120 Amanda::MainLoop::quit(); 121 } 122 }, 0, 0); 123 Amanda::MainLoop::run(); 124 125See L<http://wiki.zmanda.com/index.php/XFA> for background on the 126transfer architecture. 127 128=head1 Amanda::Xfer Objects 129 130A new transfer is created with C<< Amanda::Xfer->new() >>, which takes 131an arrayref giving the transfer elements which should compose the 132transfer. 133 134The resulting object has the following methods: 135 136=over 137 138=item start($cb, $offset, $size) 139 140Start this transfer. It transfer $size bytes starting from offset $offset. 141$offset must be 0. $size is only supported by Amanda::Xfer::Source::Recovery. 142A size of 0 transfer everything to EOF. 143Processing takes place asynchronously, and messages will 144begin queueing up immediately. If C<$cb> is given, then it is installed as the 145callback for messages from this transfer. The callback receives three 146arguments: the event source, the message, and a reference to the controlling 147transfer. See the description of C<Amanda::Xfer::Msg>, below, for details. 148 149There is no need to remove the source on completion of the transfer - that is 150handled for you. 151 152=item cancel() 153 154Stop transferring data. The transfer will send an C<XMSG_CANCEL>, 155"drain" any buffered data as best it can, and then complete normally 156with an C<XMSG_DONE>. 157 158=item get_status() 159 160Get the transfer's status. The result will be one of C<$XFER_INIT>, 161C<$XFER_START>, C<$XFER_RUNNING>, or C<$XFER_DONE>. These symbols are 162available for import with the tag C<:constants>. 163 164=item repr() 165 166Return a string representation of this transfer, suitable for use in 167debugging messages. This method is automatically invoked when a 168transfer is interpolated into a string: 169 170 print "Starting $xfer\n"; 171 172=item get_source() 173 174Get the L<Amanda::MainLoop> event source through which messages will 175be delivered for this transfer. Use its C<set_callback> method to 176connect a perl sub for processing events. 177 178Use of this method is deprecated; instead, pass a callback to the C<start> 179method. If you set a callback via C<get_source>, then you I<must> C<remove> 180the source when the transfer is complete! 181 182=back 183 184=head1 Amanda::Xfer::Element objects 185 186The individual transfer elements that compose a transfer are instances 187of subclasses of Amanda::Xfer::Element. All such objects have a 188C<repr()> method, similar to that for transfers, and support a similar 189kind of string interpolation. 190 191Note that the names of these classes contain the words "Source", 192"Filter", and "Dest". This is merely suggestive of their intended 193purpose -- there are no such abstract classes. 194 195=head2 Transfer Sources 196 197=head3 Amanda::Xfer::Source::Device (SERVER ONLY) 198 199 Amanda::Xfer::Source::Device->new($device); 200 201This source reads data from a device. The device should already be 202queued up for reading (C<< $device->seek_file(..) >>). The element 203will read until the end of the device file. 204 205=head3 Amanda::Xfer::Source::Fd 206 207 Amanda::Xfer::Source::Fd->new(fileno($fh)); 208 209This source reads data from a file descriptor. It reads until EOF, 210but does not close the descriptor. Be careful not to let Perl close 211the file for you! 212 213=head3 Amanda::Xfer::Source::Holding (SERVER-ONLY) 214 215 Amanda::Xfer::Source::Holding->new($filename); 216 217This source reads data from a holding file (see L<Amanda::Holding>). 218If the transfer only consists of a C<Amanda::Xfer::Source::Holding> 219and an C<Amanda::Xfer::Dest::Taper::Cacher> (with no filters), then the source 220will call the destination's C<cache_inform> method so that it can use 221holding chunks for a split-part cache. 222 223=head3 Amanda::Xfer::Source::Random 224 225 Amanda::Xfer::Source::Random->new($length, $seed); 226 227This source provides I<length> bytes of random data (or an unlimited 228amount of data if I<length> is zero). C<$seed> is the seed used to 229generate the random numbers; this seed can be used in a destination to 230check for correct output. 231 232If you need to string multiple transfers together into a coherent sequence of 233random numbers, for example when testing the re-assembly of spanned dumps, call 234 235 my $seed = $src->get_seed(); 236 237to get the finishing seed for the source, then pass this to the source 238constructor for the next transfer. When concatenated, the bytestreams from the 239transfers will verify correctly using the original random seed. 240 241=head3 Amanda::Xfer::Source::Pattern 242 243 Amanda::Xfer::Source::Pattern->new($length, $pattern); 244 245This source provides I<length> bytes containing copies of 246I<pattern>. If I<length> is zero, the source provides an unlimited 247number of bytes. 248 249=head3 Amanda::Xfer::Source::Recovery (SERVER ONLY) 250 251 Amanda::Xfer::Source::Recovery->new($first_device); 252 253This source reads a datastream composed of on-device files. Its constructor 254takes a pointer to the first device that will be read from; this is used 255internally to determine whether DirectTCP is supported. 256 257The element sense C<$XMSG_READY> when it is ready for the first C<start_part> 258invocation. Don't do anything with the device between the start of the 259transfer and when the element sends an C<$XMSG_READY>. 260 261The element contains no logic to decide I<which> files to assemble into the 262datastream; instead, it relies on the caller to supply pre-positioned devices: 263 264 $src->start_part($device); 265 266Once C<start_part> is called, the source will read until C<$device> produces an 267EOF. As each part is completed, the element sends an C<$XMSG_PART_DONE> 268L<Amanda::Xfer::Msg>, with the following keys: 269 270 size bytes read from the device 271 duration time spent reading 272 fileno the on-media file number from which the part was read 273 274Call C<start_part> with C<$device = undef> to indicate that there are no more 275parts. 276 277To switch to a new device in mid-transfer, use C<use_device>: 278 279 $dest->use_device($device); 280 281This method must be called with a device that is not yet started, and thus must 282be called before the C<start_part> method is called with a new device. 283 284=head3 Amanda::Xfer::Source::DirectTCPListen 285 286 Amanda::Xfer::Source::DirectTCPListen->new(); 287 288This source is for use when the transfer data will come in via DirectTCP, with 289the data's I<source> connecting to the data's I<destination>. That is, the 290data source is the connection initiator. Set up the transfer, and after 291starting it, call this element's C<get_addrs> method to get an arrayref of ip/port pairs, 292e.g., C<[ "192.168.4.5", 9924 ]>, all of which are listening for an incoming 293data connection. Once a connection arrives, this element will read data from 294it and send those data into the transfer. 295 296 my $addrs = $src->get_addrs(); 297 298=head3 Amanda::Xfer::Source::DirectTCPConnect 299 300 Amanda::Xfer::Source::DirectTCPConnect->new($addrs); 301 302This source is for use when the transfer data will come in via DirectTCP, with 303the data's I<destination> connecting to the the data's I<source>. That is, the 304data destination is the connection initiator. The element connects to 305C<$addrs> and reads the transfer data from the connection. 306 307=head2 Transfer Filters 308 309=head3 Amanda::Xfer::Filter:Process 310 311 $xfp = Amanda::Xfer::Filter::Process->new([@args], $need_root); 312 313This filter will pipe data through the standard file descriptors of the 314subprocess specified by C<@args>. If C<$need_root> is true, it will attempt to 315change to uid 0 before executing the process. Note that the process is 316invoked directly, not via a shell, so shell metacharcters (e.g., C<< 2>&1 >>) 317will not function as expected. This method create a pipe for the process 318stderr and the caller must read it or a hang may occur. 319 320 $xfp->get_stderr_fd() 321 322Return the file descriptor of the stderr pipe to read from. 323 324=head3 Amanda::Xfer::Filter:Xor 325 326 Amanda::Xfer::Filter::Xor->new($key); 327 328This filter applies a bytewise XOR operation to the data flowing 329through it. 330 331=head2 Transfer Destinations 332 333=head3 Amanda::Xfer::Dest::Device (SERVER ONLY) 334 335 Amanda::Xfer::Dest::Device->new($device, $cancel_at_eom); 336 337This source writes data to a device. The device should be ready for writing 338(C<< $device->start_file(..) >>). On completion of the transfer, the file will 339be finished. If an error occurs, or if C<$cancel_at_eom> is true and the 340device signals LEOM, the transfer will be cancelled. 341 342Note that this element does not apply any sort of stream buffering. 343 344=head3 Amanda::Xfer::Dest::Buffer 345 346 Amanda::Xfer::Dest::Buffer->new($max_size); 347 348This destination records data into an in-memory buffer which can grow up to 349C<$max_size> bytes. The buffer is available with the C<get> method, which 350returns a copy of the buffer as a perl scalar: 351 352 my $buf = $xdb->get(); 353 354=head3 Amanda::Xfer::Dest::DirectTCPListen 355 356 Amanda::Xfer::Dest::DirectTCPListen->new(); 357 358This destination is for use when the transfer data will come in via DirectTCP, 359with the data's I<destination> connecting to the data's I<source>. That is, 360the data destination is the connection initiator. Set up the transfer, and 361after starting it, call this element's C<get_addrs> method to get an arrayref 362of ip/port pairs, e.g., C<[ "192.168.4.5", 9924 ]>, all of which are listening 363for an incoming data connection. Once a connection arrives, this element will 364write the transfer data to it. 365 366 my $addrs = $src->get_addrs(); 367 368=head3 Amanda::Xfer::Dest::DirectTCPConnect 369 370 Amanda::Xfer::Dest::DirectTCPConnect->new($addrs); 371 372This destination is for use when the transfer data will come in via DirectTCP, 373with the data's I<source> connecting to the the data's I<destination>. That 374is, the data source is the connection initiator. The element connects to 375C<$addrs> and writes the transfer data to the connection. 376 377=head3 Amanda::Xfer::Dest::Fd 378 379 Amanda::Xfer::Dest::Fd->new(fileno($fh)); 380 381This destination writes data to a file descriptor. The file is not 382closed after the transfer is completed. Be careful not to let Perl 383close the file for you! 384 385=head3 Amanda::Xfer::Dest::Null 386 387 Amanda::Xfer::Dest::Null->new($seed); 388 389This destination discards the data it receives. If C<$seed> is 390nonzero, then the element will validate that it receives the data that 391C<Amanda::Xfer::Source::Random> produced with the same seed. No 392validation is performed if C<$seed> is zero. 393 394=head3 Amanda::Xfer::Dest::Taper (SERVER ONLY) 395 396This is the parent class to C<Amanda::Xfer::Dest::Taper::Cacher> and 397C<Amanda::Xfer::Dest::Taper::DirectTCP>. These subclasses allow a single 398transfer to write to multiple files (parts) on a device, and even spread those 399parts over multiple devices, without interrupting the transfer itself. 400 401The subclass constructors all take a C<$first_device>, which should be 402configured but not yet started; and a C<$part_size> giving the maximum size of 403each part. Note that this value may be rounded up internally as necessary. 404 405When a transfer using a taper destination element is first started, no data is 406transfered until the element's C<start_part> method is called: 407 408 $dest->start_part($retry_part); 409 410where C<$device> is the device to which the part should be written. The device 411should have a file open and ready to write (that is, 412C<< $device->start_file(..) >> has already been called). If C<$retry_part> is 413true, then the previous, unsuccessful part will be retried. 414 415As each part is completed, the element sends an C<$XMSG_PART_DONE> 416C<Amanda::Xfer::Msg>, with the following keys: 417 418 successful true if the part was written successfully 419 eof recipient should not call start_part again 420 eom this volume is at EOM; a new volume is required 421 size bytes written to volume 422 duration time spent writing, not counting changer ops, etc. 423 partnum the zero-based number of this part in the overall dumpfile 424 fileno the on-media file number used for this part, or 0 if no file 425 was used 426 427If C<eom> is true, then the caller should find a new volume before 428continuing. If C<eof> is not true, then C<start_part> should be called 429again, with C<$retry_part = !successful>. Note that it is possible 430for some destinations to write a portion of a part successfully, 431but still stop at EOM. That is, C<eom> does not necessarily imply 432C<!successful>. 433 434To switch to a new device in mid-transfer, use C<use_device>: 435 436 $dest->use_device($device); 437 438This method must be called with a device that is not yet started. 439 440If neither the memory nor disk caches are in use, but the dumpfile is 441available on disk, then the C<cache_inform> method allows the element 442to use that on-disk data to support retries. This is intended to 443support transfers from Amanda's holding disk (see 444C<Amanda::Xfer::Source::Holding>), but may be useful for other 445purposes. 446 447 $dest->cache_inform($filename, $offset, $length); 448 449This function indicates that C<$filename> contains C<$length> bytes of 450data, beginning at offset C<$offset> from the beginning of the file. 451These bytes are assumed to follow immediately after any bytes 452previously specified to C<cache_inform>. That is, no gaps or overlaps 453are allowed in the data stream described to C<cache_inform>. 454Furthermore, the location of each byte must be specified to this 455method I<before> it is sent through the transfer. 456 457 $dest->get_part_bytes_written(); 458 459This function returns the number of bytes written for the current part 460to the device. 461 462=head3 Amanda::Xfer::Dest::Taper::Splitter 463 464 Amanda::Xfer::Dest::Taper::Splitter->new($first_device, $max_memory, 465 $part_size, $expect_cache_inform); 466 467This class splits a data stream into parts on the storage media. It is for use 468when the device supports LEOM, when the dump is already available on disk 469(C<cache_inform>), or when no caching is desired. It does not cache parts, so 470it can only retry a partial part if the transfer source is calling 471C<cache_inform>. If the element is used with devices that do not support LEOM, 472then it will cancel the entire transfer if the device reaches EOM and 473C<cache_inform> is not in use. Set C<$expect_cache_inform> appropriately based 474on the incoming data. 475 476The C<$part_size> and C<$first_device> parameters are described above for 477C<Amanda::Xfer::Dest::Taper>. 478 479=head3 Amanda::Xfer::Dest::Taper::Cacher 480 481 Amanda::Xfer::Dest::Taper::Cacher->new($first_device, $max_memory, 482 $part_size, $use_mem_cache, $disk_cache_dirname); 483 484This class is similar to the splitter, but caches data from each part in one of 485a variety of ways to support "rewinding" to retry a failed part (e.g., one that 486does not fit on a device). It assumes that when a device reaches EOM while 487writing, the entire on-volume file is corrupt - that is, that the device does 488not support logical EOM. The class does not support C<cache_inform>. 489 490The C<$part_size> and C<$first_device> parameters are described above for 491C<Amanda::Xfer::Dest::Taper>. 492 493If C<$use_mem_cache> is true, each part will be cached in memory (using 494C<$part_size> bytes of memory; plan accordingly!). If C<$disk_cache_dirname> 495is defined, then each part will be cached on-disk in a file in this directory. 496It is an error to specify both in-memory and on-disk caching. If neither 497option is specified, the element will operate successfully, but will not be 498able to retry a part, and will cancel the transfer if a part fails. 499 500=head3 Amanda::Xfer::Dest::Taper::DirectTCP 501 502 Amanda::Xfer::Dest::Taper::DirectTCP->new($first_device, $part_size); 503 504This class uses the Device API DirectTCP methods to write data to a device via 505DirectTCP. Since all DirectTCP devices support logical EOM, this class does 506not cache any data, and will never re-start an unsuccessful part. 507 508As state above, C<$first_device> must not be started when C<new> is called. 509Furthermore, no use of that device is allowed until the element sens an 510C<$XMSG_READY> to indicate that it is finished with the device. The 511C<start_part> method must not be called until this method is received either. 512 513=head1 Amanda::Xfer::Msg objects 514 515Messages are simple hashrefs, with a few convenience methods. Like 516transfers, they have a C<repr()> method that formats the message 517nicely, and is available through string interpolation: 518 519 print "Received message $msg\n"; 520 521The canonical description of the message types and keys is in 522C<xfer-src/xmsg.h>, and is not duplicated here. Every message has the 523following basic keys. 524 525=over 526 527=item type 528 529The message type -- one of the C<xmsg_type> constants available from 530the import tag C<:constants>. 531 532=item elt 533 534The transfer element that sent the message. 535 536=item version 537 538The version of the message. This is used to support extensibility of 539the protocol. 540 541=back 542 543Additional keys are described in the documentation for the elements 544that use them. All keys are listed in C<xfer-src/xmsg.h>. 545 546=cut 547 548 549 550push @EXPORT_OK, qw(xfer_status_to_string); 551push @{$EXPORT_TAGS{"xfer_status"}}, qw(xfer_status_to_string); 552 553my %_xfer_status_VALUES; 554#Convert an enum value to a single string 555sub xfer_status_to_string { 556 my ($enumval) = @_; 557 558 for my $k (keys %_xfer_status_VALUES) { 559 my $v = $_xfer_status_VALUES{$k}; 560 561 #is this a matching flag? 562 if ($enumval == $v) { 563 return $k; 564 } 565 } 566 567#default, just return the number 568 return $enumval; 569} 570 571push @EXPORT_OK, qw($XFER_INIT); 572push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_INIT); 573 574$_xfer_status_VALUES{"XFER_INIT"} = $XFER_INIT; 575 576push @EXPORT_OK, qw($XFER_START); 577push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_START); 578 579$_xfer_status_VALUES{"XFER_START"} = $XFER_START; 580 581push @EXPORT_OK, qw($XFER_RUNNING); 582push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_RUNNING); 583 584$_xfer_status_VALUES{"XFER_RUNNING"} = $XFER_RUNNING; 585 586push @EXPORT_OK, qw($XFER_DONE); 587push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_DONE); 588 589$_xfer_status_VALUES{"XFER_DONE"} = $XFER_DONE; 590 591#copy symbols in xfer_status to constants 592push @{$EXPORT_TAGS{"constants"}}, @{$EXPORT_TAGS{"xfer_status"}}; 593 594push @EXPORT_OK, qw(xmsg_type_to_string); 595push @{$EXPORT_TAGS{"xmsg_type"}}, qw(xmsg_type_to_string); 596 597my %_xmsg_type_VALUES; 598#Convert an enum value to a single string 599sub xmsg_type_to_string { 600 my ($enumval) = @_; 601 602 for my $k (keys %_xmsg_type_VALUES) { 603 my $v = $_xmsg_type_VALUES{$k}; 604 605 #is this a matching flag? 606 if ($enumval == $v) { 607 return $k; 608 } 609 } 610 611#default, just return the number 612 return $enumval; 613} 614 615push @EXPORT_OK, qw($XMSG_INFO); 616push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_INFO); 617 618$_xmsg_type_VALUES{"XMSG_INFO"} = $XMSG_INFO; 619 620push @EXPORT_OK, qw($XMSG_ERROR); 621push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_ERROR); 622 623$_xmsg_type_VALUES{"XMSG_ERROR"} = $XMSG_ERROR; 624 625push @EXPORT_OK, qw($XMSG_DONE); 626push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_DONE); 627 628$_xmsg_type_VALUES{"XMSG_DONE"} = $XMSG_DONE; 629 630push @EXPORT_OK, qw($XMSG_CANCEL); 631push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_CANCEL); 632 633$_xmsg_type_VALUES{"XMSG_CANCEL"} = $XMSG_CANCEL; 634 635push @EXPORT_OK, qw($XMSG_PART_DONE); 636push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_PART_DONE); 637 638$_xmsg_type_VALUES{"XMSG_PART_DONE"} = $XMSG_PART_DONE; 639 640push @EXPORT_OK, qw($XMSG_READY); 641push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_READY); 642 643$_xmsg_type_VALUES{"XMSG_READY"} = $XMSG_READY; 644 645#copy symbols in xmsg_type to constants 646push @{$EXPORT_TAGS{"constants"}}, @{$EXPORT_TAGS{"xmsg_type"}}; 647 648sub xfer_start_with_callback { 649 my ($xfer, $cb, $offset, $size) = @_; 650 if (defined $cb) { 651 my $releasing_cb = sub { 652 my ($src, $msg, $xfer) = @_; 653 my $done = $msg->{'type'} == $XMSG_DONE; 654 $src->remove() if $done; 655 $cb->(@_); 656 $cb = undef if $done; # break potential reference loop 657 }; 658 $xfer->get_source()->set_callback($releasing_cb); 659 } 660 $offset = 0 if !defined $offset; 661 $size = 0 if !defined $size; 662 xfer_start($xfer, $offset, $size); 663} 664 665sub xfer_set_callback { 666 my ($xfer, $cb) = @_; 667 if (defined $cb) { 668 my $releasing_cb = sub { 669 my ($src, $msg, $xfer) = @_; 670 my $done = $msg->{'type'} == $XMSG_DONE; 671 $src->remove() if $done; 672 $cb->(@_); 673 $cb = undef if $done; # break potential reference loop 674 }; 675 $xfer->get_source()->set_callback($releasing_cb); 676 } else { 677 $xfer->get_source()->set_callback(undef); 678 } 679} 680 681package Amanda::Xfer::Xfer; 682 683sub new { 684 my $pkg = shift; 685#The C function adds the proper blessing -- this function 686#just gets $pkg out of the way. 687 Amanda::Xfer::xfer_new(@_); 688} 689 *DESTROY = *Amanda::Xfer::xfer_unref; 690 691use overload '""' => sub { $_[0]->repr(); }; 692#overload comparison, so users can ask if one obj == another 693use overload '==' => sub { Amanda::Xfer::same_elements($_[0], $_[1]); }; 694use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); }; 695 *repr = *Amanda::Xfer::xfer_repr; 696 *get_status = *Amanda::Xfer::xfer_get_status; 697 *get_source = *Amanda::Xfer::xfer_get_amglue_source; 698 *start = *Amanda::Xfer::xfer_start_with_callback; 699 *set_callback = *Amanda::Xfer::xfer_set_callback; 700 *cancel = *Amanda::Xfer::xfer_cancel; 701 702package Amanda::Xfer::Element; 703 *DESTROY = *Amanda::Xfer::xfer_element_unref; 704 705use overload '""' => sub { $_[0]->repr(); }; 706#overload comparison, so users can ask if one obj == another 707use overload '==' => sub { Amanda::Xfer::same_elements($_[0], $_[1]); }; 708use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); }; 709 *repr = *Amanda::Xfer::xfer_element_repr; 710 711package Amanda::Xfer::Element::Glue; 712 713use vars qw(@ISA); 714@ISA = qw( Amanda::Xfer::Element ); 715 716package Amanda::Xfer::Source::Fd; 717 718use vars qw(@ISA); 719@ISA = qw( Amanda::Xfer::Element ); 720 721sub new { 722 my $pkg = shift; 723#The C function adds the proper blessing -- this function 724#just gets $pkg out of the way. 725 Amanda::Xfer::xfer_source_fd(@_); 726} 727 728package Amanda::Xfer::Source::Random; 729 730use vars qw(@ISA); 731@ISA = qw( Amanda::Xfer::Element ); 732 733sub new { 734 my $pkg = shift; 735#The C function adds the proper blessing -- this function 736#just gets $pkg out of the way. 737 Amanda::Xfer::xfer_source_random(@_); 738} 739 *get_seed = *Amanda::Xfer::xfer_source_random_get_seed; 740 741package Amanda::Xfer::Source::DirectTCPListen; 742 743use vars qw(@ISA); 744@ISA = qw( Amanda::Xfer::Element ); 745 746sub new { 747 my $pkg = shift; 748#The C function adds the proper blessing -- this function 749#just gets $pkg out of the way. 750 Amanda::Xfer::xfer_source_directtcp_listen(@_); 751} 752 *get_addrs = *Amanda::Xfer::xfer_source_directtcp_listen_get_addrs; 753 754package Amanda::Xfer::Source::DirectTCPConnect; 755 756use vars qw(@ISA); 757@ISA = qw( Amanda::Xfer::Element ); 758 759sub new { 760 my $pkg = shift; 761#The C function adds the proper blessing -- this function 762#just gets $pkg out of the way. 763 Amanda::Xfer::xfer_source_directtcp_connect(@_); 764} 765 766package Amanda::Xfer::Source::Pattern; 767 768use vars qw(@ISA); 769@ISA = qw( Amanda::Xfer::Element ); 770 771sub new { 772 my $pkg = shift; 773#The C function adds the proper blessing -- this function 774#just gets $pkg out of the way. 775 Amanda::Xfer::xfer_source_pattern(@_); 776} 777 778package Amanda::Xfer::Filter::Xor; 779 780use vars qw(@ISA); 781@ISA = qw( Amanda::Xfer::Element ); 782 783sub new { 784 my $pkg = shift; 785#The C function adds the proper blessing -- this function 786#just gets $pkg out of the way. 787 Amanda::Xfer::xfer_filter_xor(@_); 788} 789 790package Amanda::Xfer::Filter::Process; 791 792use vars qw(@ISA); 793@ISA = qw( Amanda::Xfer::Element ); 794 795sub new { 796 my $pkg = shift; 797#The C function adds the proper blessing -- this function 798#just gets $pkg out of the way. 799 Amanda::Xfer::xfer_filter_process(@_); 800} 801 *get_stderr_fd = *Amanda::Xfer::get_err_fd; 802 803package Amanda::Xfer::Dest::Fd; 804 805use vars qw(@ISA); 806@ISA = qw( Amanda::Xfer::Element ); 807 808sub new { 809 my $pkg = shift; 810#The C function adds the proper blessing -- this function 811#just gets $pkg out of the way. 812 Amanda::Xfer::xfer_dest_fd(@_); 813} 814 815package Amanda::Xfer::Dest::Null; 816 817use vars qw(@ISA); 818@ISA = qw( Amanda::Xfer::Element ); 819 820sub new { 821 my $pkg = shift; 822#The C function adds the proper blessing -- this function 823#just gets $pkg out of the way. 824 Amanda::Xfer::xfer_dest_null(@_); 825} 826 827package Amanda::Xfer::Dest::Buffer; 828 829use vars qw(@ISA); 830@ISA = qw( Amanda::Xfer::Element ); 831 832sub new { 833 my $pkg = shift; 834#The C function adds the proper blessing -- this function 835#just gets $pkg out of the way. 836 Amanda::Xfer::xfer_dest_buffer(@_); 837} 838 *get = *Amanda::Xfer::xfer_dest_buffer_get; 839 840package Amanda::Xfer::Dest::DirectTCPListen; 841 842use vars qw(@ISA); 843@ISA = qw( Amanda::Xfer::Element ); 844 845sub new { 846 my $pkg = shift; 847#The C function adds the proper blessing -- this function 848#just gets $pkg out of the way. 849 Amanda::Xfer::xfer_dest_directtcp_listen(@_); 850} 851 *get_addrs = *Amanda::Xfer::xfer_dest_directtcp_listen_get_addrs; 852 853package Amanda::Xfer::Dest::DirectTCPConnect; 854 855use vars qw(@ISA); 856@ISA = qw( Amanda::Xfer::Element ); 857 858sub new { 859 my $pkg = shift; 860#The C function adds the proper blessing -- this function 861#just gets $pkg out of the way. 862 Amanda::Xfer::xfer_dest_directtcp_connect(@_); 863} 864 865package Amanda::Xfer::Msg; 866 867use Data::Dumper; 868use overload '""' => sub { $_[0]->repr(); }; 869 870sub repr { 871 my ($self) = @_; 872 local $Data::Dumper::Indent = 0; 873 local $Data::Dumper::Terse = 1; 874 local $Data::Dumper::Useqq = 1; 875 876 my $typestr = Amanda::Xfer::xmsg_type_to_string($self->{'type'}); 877 my $str = "{ type => \$$typestr, elt => $self->{'elt'}, version => $self->{'version'},"; 878 879 my %skip = ( "type" => 1, "elt" => 1, "version" => 1 ); 880 for my $k (keys %$self) { 881 next if $skip{$k}; 882 $str .= " $k => " . Dumper($self->{$k}) . ","; 883 } 884 885 # strip the trailing comma and add a closing brace 886 $str =~ s/,$/ }/g; 887 888 return $str; 889} 890 891package Amanda::Xfer; 892 893# make Amanda::Xfer->new equivalent to Amanda::Xfer::Xfer->new (don't 894# worry, the blessings work out just fine) 895*new = *Amanda::Xfer::Xfer::new; 896 897# try to load Amanda::XferServer, which is server-only. If it's not found, then 898# its classes just remain undefined. 899BEGIN { 900 use Amanda::Util; 901 if (Amanda::Util::built_with_component("server")) { 902 eval "use Amanda::XferServer;"; 903 } 904} 9051; 906