[Midnightbsd-cvs] mports: App/Slave: start of new filetransfer API.

[ctriv at midnightbsd.org]

Log Message:
-----------
start of new filetransfer API.

Added Files:
-----------
    mports/Tools/lib/Magus/App/Slave:
        FileTransfer.pm (r1.1)
    mports/Tools/lib/Magus/App/Slave/FileTransfer:
        Base.pm (r1.1)
        LocalFS.pm (r1.1)

-------------- next part --------------
--- /dev/null
+++ Tools/lib/Magus/App/Slave/FileTransfer.pm
@@ -0,0 +1,73 @@
+package Magus::App::Slave::FileTransfer;
+
+use strict;
+use warnings;
+
+=head1 Magus::FileTransfer
+
+A utility class (set of classes really) for moving files around.
+
+=cut
+
+use Magus::App::Slave::FileTransfer::LocalFS;
+use Magus::App::Slave::FileTransfer::SFTP;
+
+my %valid_classes = map { $_ => 1 } qw(LocalFS SFTP);
+
+=head1 API
+
+=head2 new(%args)
+
+Creates a new file transfer object.  
+
+  run    => $magusRunObject
+  
+Optional arguments:
+
+  transfer_mode => LocalFS|SFTP
+
+If transfer_mode is not give, then the value in %Magus::Config is used.
+
+=cut
+
+sub new {
+  shift;  # we don't care about the class we're called as.  We've got a 
+          # configuration directive to set the class
+
+  my (%args) = @_;
+
+  my $mode = delete $args{TransferMode} || $Magus::Config{TransferMode};
+  
+  $valid_classes{$mode} || die "Invalid TransferMode: $mode\n";
+
+  my $class  = __PACKAGE__ . $mode;
+  
+  return $class->new(%args);
+}
+
+=head2 get_distfile($url, $destination_dir)
+
+Takes a url to a distfile, and transfers the file to the correct location in the chroot.
+
+=head2 get_pkgfile($port, $destination_dir)
+
+Get the package file for the given port object, and place it in the destination dir.
+
+=head2 put_pkgfile($port, $local_dir)
+
+Upload a pkg file for the given port, finding the file in $local_dir.
+
+=head2 get_run_tarball($run, $destination_dir)
+
+Get the run tarball from the master.
+
+=cut
+
+1;
+__END__
+
+
+  
+  
+  
+
--- /dev/null
+++ Tools/lib/Magus/App/Slave/FileTransfer/LocalFS.pm
@@ -0,0 +1,67 @@
+package Magus::App::Slave::FileTransfer::LocalFS;
+
+use strict;
+use warnings;
+
+use base 'Magus::App::Slave::FileTransfer::Base';
+
+use File::Copy;
+
+ 
+=head2 get_distfile($url, $destination_dir)
+
+Takes a url to a distfile, and transfers the file to the correct location in the chroot.
+
+=cut
+
+sub get_distfile {
+  die "XXX - Don't know how this is going to work";
+}
+
+
+=head2 get_pkgfile($port, $destination_dir)
+
+Get the package file for the given port object, and place it in the destination dir.
+
+=cut
+
+sub get_pkgfile {
+  my ($class, $port, $destination) = @_;
+
+  my $file = sprintf("%s-%s.%s", $port->pkgname, $port->version, $Magus::Config{'PkgExtension'});
+  my $path = join('/', $Magus::Config{'PkgfilesRoot'}, $port->run->id);
+  
+  $self->_copy("$path/$file", "$destination/$file");
+}
+
+
+=head2 put_pkgfile($port, $local_dir)
+
+Upload a pkg file for the given port, finding the file in $local_dir.
+
+=cut
+
+sub put_pkgfile {
+  my ($class, $port, $local) = @_;
+  
+  my $file = sprintf("%s-%s.%s", $port->pkgname, $port->version, $Magus::Config{'PkgExtension'});
+  my $dest = join('/', $Magus::Config{'PkgfilesRoot'}, $port->run->id);
+  
+  $self->_copy("$local/$file", "$dest/$file");  
+}
+
+
+sub _copy {
+  my ($self, $from, $to) = @_;
+  
+  File::Copy::copy($from, $to) || die "Couldn't not cp $from $to: $!\n";
+}
+
+1;
+__END__
+
+
+
+
+1;
+__END__
--- /dev/null
+++ Tools/lib/Magus/App/Slave/FileTransfer/Base.pm
@@ -0,0 +1,96 @@
+package Magus::App::Slave::FileTransfer::Base;
+
+use strict;
+use warnings;
+
+sub new {
+  my ($class, %args) = @_;
+
+  return bless \%args, $class;
+}
+ 
+=head2 get_distfile($url, $destination_dir)
+
+Takes a url to a distfile, and transfers the file to the correct location in the chroot.
+
+=cut
+
+sub get_distfile {
+  die "XXX - Don't know how this is going to work";
+}
+
+
+=head2 get_pkgfile($port, $destination_dir)
+
+Get the package file for the given port object, and place it in the destination dir.
+
+=cut
+
+sub get_pkgfile {
+  my ($class) = @_;
+  
+  die "$class has not implemented get_pkgfile();\n";
+}
+
+
+=head2 put_pkgfile($port, $local_dir)
+
+Upload a pkg file for the given port, finding the file in $local_dir.
+
+=cut
+
+sub put_pkgfile {
+  my ($class) = @_;
+  
+  die "$class has not implemented put_pkgfile();\n";
+}
+
+
+
+=head2 get_run_tarball($run, $destination_dir)
+
+Get the run tarball from the master.
+
+XXX - This needs to be cleaned up to be more flexible and configurable.
+
+=cut
+            
+sub get_run_tarball {
+  my ($self, $run, $dir) = @_;
+  
+  my $tarball = $run->tarballpath;
+                      
+  eval { $self->_system("/usr/bin/fetch -o $dir -p $tarball") };
+  
+  if ($@) {
+    die "Couldn't fetch $tarball: $@";
+  }
+}
+
+
+
+sub _system {
+  my ($self, $cmd) = @_;
+  
+  local $SIG{CHLD} = 'DEFAULT';
+    
+  if (system($cmd) != 0) {
+    if ($? == -1) {
+      die qq{"$cmd" failed to execute: $!\n};
+    } elsif ($? & 127) {
+      my $dumped = ($? & 128) ? 'with' : 'without';
+      my $sig = $? & 127;
+      die qq{"$cmd" died with signal $sig, $dumped coredump\n},
+    } else {
+      my $exit = $? >> 8;
+      die qq{"$cmd" exited non-zero: $exit\n};
+    }
+  }
+  
+  return 1;
+}  
+                                                                                                                                                                                                   
+  
+1;
+__END__
+                                                  
\ No newline at end of file