view data_nfs/export.pl @ 0:9974ff5df008 default tip

Uploaded
author edward-kirton
date Thu, 01 Dec 2011 20:41:36 -0500
parents
children
line wrap: on
line source

#!/usr/bin/perl

use strict;
use File::Copy;
use File::Basename;

# SETTINGS
my $password='jgi'; # changeme

# ARGS
my ($trypass, $symlink, $dest, $logfile, @files)=@ARGV;
die("Invalid password\n") unless $trypass and $password and $trypass eq $password;
die("Absolute path required\n") unless $dest =~ /^\//;
die("Paths containing '..' are disallowed\n") if $dest =~ /\/\.\.\//;
die("Only /home/*, /house/*, and /ifs/* paths are allowed\n") unless $dest =~ /^\/home/ or $dest =~ /^\/house/ or $dest =~ /^\/ifs/;
die("Destination folder does not exist: $dest\n") unless -e $dest;
die("Destination path is not a folder: $dest\n") unless -d $dest;

# CP
open(OUT, ">$logfile") or die($!);
while (@files) {
    my $file=shift @files or die("Source filename required\n");
    my $name=shift @files or die("Destination filename required\n");
    print OUT "$file -> $dest/$name\n";
    if ($symlink) {
        symlink($file, "$dest/$name");
    } else {
        copy($file, "$dest/$name");
    }
}
close OUT;
print "Exported ", scalar(@files), " to $dest\n";
exit;
__END__
Copyright (c) 2011 US DOE Joint Genome Institute.
Use freely under the same license as Galaxy itself.