From 1fbeb53e3b13ef24709c74c35ec19d3f5ed58703 Mon Sep 17 00:00:00 2001 From: Paul Kolano Date: Thu, 16 Sep 2021 17:26:08 -0700 Subject: [PATCH] Shift 8.0 --- CHANGES | 19 ++ INSTALL | 6 - README.md | 3 +- c/shift-bin.c | 11 +- doc/shiftc.1 | 140 +++++---- etc/shiftrc | 8 - perl/shift-aux | 26 +- perl/shift-mgr | 807 ++++++++++++++++++++++++++----------------------- perl/shiftc | 383 +++++------------------ 9 files changed, 623 insertions(+), 780 deletions(-) diff --git a/CHANGES b/CHANGES index 4dc201e..65becdc 100644 --- a/CHANGES +++ b/CHANGES @@ -341,3 +341,22 @@ CHANGES - Fixed manager exception during read of corrupt/incomplete gzi files - Fixed handling of manager disk exhaustion to prevent finalized metadata - Fixed potential divide by zero exceptions during throttling + - Fixed lustre handling in shift-bin to current lustre API + +* Shift 8.0 (09/16/21) + - Note that metadata is not backward compatible with previous versions + - Added plots by tool, subnet, and batch size + - Added detection of BeeGFS file systems + - Changed plots from line to heatmap for improved scalability + - Changed processing so batches only contain single operation type + - Changed monitoring to support manager hosts across shared file system + - Changed naming of built-in tools in --stats and new --plot by tool + - Fixed detection of DMF file systems when using xdsm mount option + - Fixed detection of GPFS file systems when mmlsmgr not user-accessible + - Fixed --wait status retrieval when integrated with Mesh framework + - Fixed shift-bin striping with lustre progressive layouts when --stripe=0 + - Fixed use of XS Data::MessagePack when embedded pure perl version differs + - Fixed scalability of built-in yEnc encoding/decoding + - Fixed unnecessary metadata traversal when showing detailed status + - Fixed application of lustre striping expression to directories + - Removed bbcp and gridftp support since reported fatal bugs never fixed diff --git a/INSTALL b/INSTALL index 0b95bd1..af05529 100644 --- a/INSTALL +++ b/INSTALL @@ -63,15 +63,10 @@ Shift Installation and Configuration (https://metacpan.org/pod/Data::MessagePack) o IO::Socket::SSL - allows fish-tcp encryption with --secure (https://metacpan.org/pod/IO::Socket::SSL) - o bbcp - high speed remote copy - (http://www.slac.stanford.edu/~abh/bbcp) - (note latest v17.12.00.00.0 fails when overwriting existing files) o bbftp - high speed remote copy (http://doc.in2p3.fr/bbftp) o gnuplot >= 5.0 - allow display of --plot output (http://gnuplot.info) - o gridftp - high speed remote copy - (http://toolkit.globus.org/toolkit/data/gridftp) o mcp/msum >= 1.76.7 - high speed local copy/sum (http://mutil.sf.net) o mesh - lightweight single sign-on via ssh publickey authentication @@ -97,7 +92,6 @@ Shift Installation and Configuration o su - become non-root process to access manager during root transfers o sysctl - determine number of cpus on BSD o touch - change symlink modification time - o unbuffer - interleave stdout/stderr when using gridftp 3. Build (optional - linux only) diff --git a/README.md b/README.md index 28d5a01..f468ce3 100644 --- a/README.md +++ b/README.md @@ -59,8 +59,7 @@ Shift includes the following features, among others: - fully self-contained besides perl core and ssh - automatic detection and selection of higher performance transports and - hash utilities when available including bbcp, bbftp, gridftp, mcp, msum, - and rsync + hash utilities when available including bbftp, mcp, msum, and rsync - automatic many-to-many parallelization of single and multi-file transfers with file system equivalence detection and rewriting diff --git a/c/shift-bin.c b/c/shift-bin.c index 3f10aa9..90c8f01 100644 --- a/c/shift-bin.c +++ b/c/shift-bin.c @@ -1,5 +1,5 @@ // -// Copyright (C) 2012-2020 United States Government as represented by the +// Copyright (C) 2012-2021 United States Government as represented by the // Administrator of the National Aeronautics and Space Administration // (NASA). All Rights Reserved. // @@ -252,6 +252,15 @@ int do_getstripe(char *file) { ////////////////////// int do_setstripe(char *file, int scount, unsigned long long ssize, char *pool) { #ifndef _NO_LUSTRE + if (scount == 0 && ssize == 0) { + FILE *rc = fopen(file, "w"); + if (rc != NULL) { + fclose(rc); + return 0; + } else { + return -1; + } + } return llapi_file_create_pool(file, ssize, -1, scount, 0, pool); #else return -1; diff --git a/doc/shiftc.1 b/doc/shiftc.1 index 9ba7728..9003187 100644 --- a/doc/shiftc.1 +++ b/doc/shiftc.1 @@ -58,8 +58,7 @@ automatic striping of files transferred to Lustre file systems fully self-contained besides perl core and ssh .IP - automatic detection and selection of higher performance transports and -hash utilities when available including bbcp, bbftp, gridftp, mcp, -msum, and rsync +hash utilities when available including bbftp, mcp, msum, and rsync .IP - automatic many-to-many parallelization of single and multi-file transfers with file system equivalence detection and rewriting @@ -130,10 +129,11 @@ given in following sections. \-\-mgr\-user=USER access manager host as USER \-\-monitor[=FORMAT] monitor progress of running transfers (FORMAT one of {color,csv,pad}) -\-\-plot[=[BY:]LIST] plot detailed performance when piped to gnuplot - (BY one of {client,host,id,user}) - (LIST subset of {chattr,cksum,cp,find,io,ln,meta, - mkdir,sum}) +\-\-plot[=[BY[:/]]LIST] plot detailed performance when piped to gnuplot + (BY one of {client,fs,host,id,net,user}) + (LIST subset of {bbftp,chattr,cksum,cp,find,fish,fish-tcp, + io,ln,mcp,meta, mkdir,msum,rsync,shift-cp, + shift-sum,sum,tool}) \-\-restart[=ignore] restart transfer with given \-\-id [ignoring errors] \-\-search=REGEX show only status/history matching REGEX \-\-state=STATE show status of only those operations in STATE @@ -153,12 +153,10 @@ given in following sections. (use suffix {k,m,b/g,t} for 1E{3,6,9,12}) [1k] \-\-interval=NUM adjust batches to run for around NUM seconds [30] \-\-local=LIST set local transport mechanism to one of LIST - (LIST subset of {bbcp,bbftp,fish,fish-tcp,gridftp, - mcp,rsync,shift}) + (LIST subset of {bbftp,fish,fish-tcp,mcp,rsync,shift}) \-\-preallocate=NUM preallocate files when sparsity under NUM percent \-\-remote=LIST set remote transport mechanism to one of LIST - (LIST subset of {bbcp,bbftp,fish,fish-tcp,gridftp, - rsync,shift}) + (LIST subset of {bbftp,fish,fish-tcp,rsync,shift}) \-\-retry=NUM retry failed operations up to NUM times [2] \-\-size=SIZE process transfer in batches of at least SIZE bytes (use suffix {k,m,g,t} for {KB,MB,GB,TB}) [4g] @@ -356,10 +354,9 @@ there is actually a need to process destination files during the transfer. .IP "\fB\-\-ports=NUM1:NUM2\fP" Use ports from the range NUM1-NUM2 for the data streams of TCP-based -transports (currently, bbcp, bbftp, fish-tcp, and gridftp). All -connections originate from the client host so the given port range must -be allowed on the network path to the remote host and by the remote host -itself. +transports (currently, bbftp and fish-tcp). All connections +originate from the client host so the given port range must be allowed +on the network path to the remote host and by the remote host itself. .IP "\fB\-R, \-r, \-\-recursive\fP" Transfer directories recursively. This option implies \fB\-\-no\-dereference\fP.Note that any symbolic links pointing @@ -521,24 +518,39 @@ coloring, respectively. When \fB\-\-id\fP is specified, only the given transfer will be shown. When all transfers (or the one specified) have completed, the command will exit. This option may be used with \fB\-\-wait\fP to monitor progress while waiting. -.IP "\fB\-\-plot=[=[BY:]LIST]\fP" +.IP "\fB\-\-plot=[=[BY[:/]]LIST]\fP" Produce output suitable for piping into gnuplot (version 5 or above) that shows detailed performance over time across all transfers. The \fB\-\-id\fP and \fB\-\-state\fP options may be used to plot only a single transfer or transfers in a particular state, respectively. The default plot will show the aggregate performance of each I/O operation (i.e. cp, sum, and cksum) and the aggregate performance of each metadata -operation (i.e. find, mkdir, ln, and chattr). I/O operations are -plotted against the left y-axis while metadata operations are plotted -against the right y-axis. The list of plotted items may be changed by -giving a comma-separated list consisting of one of more of {chattr, -cksum, cp, find, io, ln, meta, mkdir, sum}. Note that "io" is a -shorthand for "cp,sum,cksum" and "meta" is a shorthand for -"find,mkdir,ln,chattr". The list of items may be grouped by any of -{host, id, user} by prefixing one of these terms to the list. For -example, \fB\-\-plot=id:cp\fP would show a curve for the copy -performance of each tranfer id. When a grouping is given without a -specific list of metrics (e.g. \fB\-\-plot=id\fP), "io" is assumed. +operation (i.e. find, mkdir, ln, and chattr) across all of the user's +transfers. Operations and/or additional groupings are shown on the +left y-axis axis across time on the x-axis with heat-based coloring +indicating MB/s for I/O operations or operations per second for metadata +operations. In addition, aggregate I/O and metadata performance will be +shown as an overlayed point plot with green and blue points, +respectively. +.IP +The list of plotted items may be changed by giving a comma-separated +list consisting of one or more of the stages {chattr, cksum, cp, find, +io, ln, meta, mkdir, sum} and/or one or more of the tools {bbftp, fish, +fish-tcp, mcp, msum, rsync, shift-cp, shift-sum}. Note that "io" is a +shorthand for "cp,sum,cksum", "meta" is a shorthand for +"find,mkdir,ln,chattr", and "tool" is a shorthand for +"bbftp,fish,fish-tcp,mcp,msum,rsync,shift-cp,shift-sum". +.IP +The list of items may be grouped by any of {client, fs, host, id, net, +user} by prefixing one of these terms to the list. For example, +\fB\-\-plot=id:cp\fP would show a plot of the copy performance achieved +by each transfer id. When a grouping is given without a specific list +of metrics (e.g. \fB\-\-plot=id\fP), "io" is assumed. When a slash "/" +is used instead of colon ":", a heatmap-based bubble plot will be +created with the size of each circle indicating the relative size of the +batch of operations. For example, \fB\-\-plot=fs/tool\fP would show a +plot of the performance that each tool achieved on each file system +with relative batch size. .IP "\fB\-\-restart[=ignore]\fP" Restart the transfer associated with the given \fB\-\-id\fP that was stopped due to unrecoverable errors or stopped explicitly via @@ -623,12 +635,12 @@ Some advanced options are available to tune various aspects of shiftc behavior. These options are not needed by most users. .IP "\fB\-\-bandwidth=BITS\fP" Choose the TCP window size and number of TCP streams of TCP-based -transports (currently, bbcp, bbftp, fish-tcp, and gridftp) based on -the given bits per second. The suffixes k, m, g, and t may be used for -Kb, Mb, Gb, and Tb, respectively. The default bandwidth is estimated to -be 10 Gb/s if a 10 GE adapter is found on the client host, 1 Gb/s if the -client host can be resolved to an organization domain (by default, one -of the six original generic top-level domains), and 100 Mb/s otherwise. +transports (currently, bbftp and fish-tcp) based on the given bits per +second. The suffixes k, m, g, and t may be used for Kb, Mb, Gb, and Tb, +respectively. The default bandwidth is estimated to be 10 Gb/s if a 10 +GE adapter is found on the client host, 1 Gb/s if the client host can be +resolved to an organization domain (by default, one of the six original +generic top-level domains), and 100 Mb/s otherwise. .IP "\fB\-\-buffer=SIZE\fP" Use memory buffer(s) of the given size when configurable in the underlying tranport being utilized (currently, all but rsync). The @@ -662,13 +674,13 @@ for manager locks. To make batch selection completely static, use .IP "\fB\-\-local=LIST\fP" Specify one or more local transports to be used for the transfer in order of preference, separated by commas. Valid transports for this -option currently include bbcp, bbftp, cp, fish, fish-tcp, gridftp, -mcp, and rsync. Note that the given transport(s) will be given -priority, but may not be used in some cases (e.g. rsync is not capable -of transferring a specific portion of a file as needed by verification -mode). In such cases, the default transport based on File::Copy will be -used. The tool actually used for each file operation can be shown using -\fB\-\-status\fP with \fB\-\-id\fP set to the given transfer identifier. +option currently include bbftp, cp, fish, fish-tcp, mcp, and rsync. +Note that the given transport(s) will be given priority, but may not be +used in some cases (e.g. rsync is not capable of transferring a specific +portion of a file as needed by verification mode). In such cases, the +default transport based on File::Copy will be used. The tool actually +used for each file operation can be shown using \fB\-\-status\fP with +\fB\-\-id\fP set to the given transfer identifier. .IP "\fB\-\-preallocate=NUM\fP" Preallocate files when their sparsity is under the given percent, where sparsity is defined as the number of bytes a file takes up on disk @@ -681,14 +693,13 @@ transport due to their use of temporary files. .IP "\fB\-\-remote=LIST\fP" Specify one or more remote transports to be used for the transfer in order of preference, separated by commas. Valid transports for this -option currently include bbcp, bbftp, fish, fish-tcp, gridftp, rsync, -and sftp. Note that the given transport(s) will be given priority, but -may not be used in some cases (e.g. bbftp is not capable of transferring -files with spaces in their names and is also incompatible with -\fB\-\-secure\fP). In such cases, the default transport based on sftp -will be used. The tool actually used for each file operation can be -shown using \fB\-\-status\fP with \fB\-\-id\fP set to the given transfer -identifier. +option currently include bbftp, fish, fish-tcp, rsync, and sftp. Note +that the given transport(s) will be given priority, but may not be used +in some cases (e.g. bbftp is not capable of transferring files with +spaces in their names and is also incompatible with \fB\-\-secure\fP). +In such cases, the default transport based on sftp will be used. The +tool actually used for each file operation can be shown using +\fB\-\-status\fP with \fB\-\-id\fP set to the given transfer identifier. .IP "\fB\-\-retry=NUM\fP" Retry operations deemed recoverable up to the given number of attempts per file. The default number of retries is 2. A value of zero disables @@ -733,13 +744,13 @@ resulting tar files may still be larger than specified when source files exist that are larger than the given size. .IP "\fB\-\-streams=NUM\fP" Use the given number of TCP streams in TCP-based transports (currently, -bbcp, bbftp, fish-tcp, and gridftp). The default is the number of -streams necessary to fully utilize the specified/estimated bandwidth -using the maximum TCP window size. Note that it is usually preferable -to specify \fB\-\-bandwidth\fP, which allows an appropriate number of -streams to be set automatically. Increasing the number of streams can -increase performance when the maximum window size is set too low or -there is cross-traffic on the network, but too high a value can decrease +bbftp and fish-tcp). The default is the number of streams necessary +to fully utilize the specified/estimated bandwidth using the maximum TCP +window size. Note that it is usually preferable to specify +\fB\-\-bandwidth\fP, which allows an appropriate number of streams to be +set automatically. Increasing the number of streams can increase +performance when the maximum window size is set too low or there is +cross-traffic on the network, but too high a value can decrease performance due to increased congestion and packet loss. .IP "\fB\-\-stripe=[CEXP][::[SEXP][::PEXP]]\fP" By default, a file transferred to a Lustre file system will be striped @@ -797,15 +808,14 @@ to 33%, but does not allow bits corrupted during the initial read to be detected. .IP "\fB\-\-window=SIZE\fP" Use a TCP send/receive window of the given size in TCP-based transports -(currently, bbcp, bbftp, fish-tcp, and gridftp). The suffixes k, m, -g, and t may be used for KB, MB, GB, and TB, respectively. The default -is the product of the specified/estimated bandwidth and the round-trip -time between source and destination. Note that it is usually preferable -to specify \fB\-\-bandwidth\fP, which allows an appropriate window size -to be set automatically. Increasing the window size allows TCP to -operate more efficiently over high bandwidth and/or high latency -networks, but too high a value can overrun the receiver and cause packet -loss. +(currently, bbftp and fish-tcp). The suffixes k, m, g, and t may be +used for KB, MB, GB, and TB, respectively. The default is the product +of the specified/estimated bandwidth and the round-trip time between +source and destination. Note that it is usually preferable to specify +\fB\-\-bandwidth\fP, which allows an appropriate window size to be set +automatically. Increasing the window size allows TCP to operate more +efficiently over high bandwidth and/or high latency networks, but too +high a value can overrun the receiver and cause packet loss. ./"################################################################ .SH "TRANSFER THROTTLING" ./"################################################################ @@ -1142,5 +1152,5 @@ shiftc was written by Paul Kolano. ./"################################################################ .SH "SEE ALSO" ./"################################################################ -bbcp(1), bbftp(1), cp(1), Date::Parse(3), globus-url-copy(1), mcp(1), -msum(1), perlre(1), perlsyn(1), rsync(1), scp(1), sftp(1) +bbftp(1), cp(1), Date::Parse(3), mcp(1), msum(1), perlre(1), +perlsyn(1), rsync(1), scp(1), sftp(1) diff --git a/etc/shiftrc b/etc/shiftrc index 911166a..0847bca 100644 --- a/etc/shiftrc +++ b/etc/shiftrc @@ -78,20 +78,12 @@ user_dir /home/%u/.shift # (example: mcp,shift,fish,fish-tcp,rsync,bbftp) #local_small shift,fish,fish-tcp -# command-line options that will be used by bbcp on client hosts -# (example: opts_bbcp -s 4 -w 4194304) -#opts_bbcp nodefault - # behavior commands that will be used by bbftp on client hosts # (see the "behavior commands" section of bbftp man page for details) # (options must be separated by "\n" as shown in example below) # (example: opts_bbftp setnbstream 4\nsetrecvwinsize 4096\nsetsendwinsize 4096) #opts_bbftp nodefault -# command-line options that will be used by globus-url-copy on client hosts -# (example: opts_gridftp -p 4 -tcp-bs 4194304) -#opts_gridftp nodefault - # command-line options that will be used by mcp on client hosts # (if mcp >= 1.822.1, a --preallocate setting is recommended for DMF on CXFS) #opts_mcp --double-buffer diff --git a/perl/shift-aux b/perl/shift-aux index 718f1a3..fa20cf5 100755 --- a/perl/shift-aux +++ b/perl/shift-aux @@ -66,7 +66,7 @@ use Symbol qw(gensym); use Sys::Hostname; use Text::ParseWords; -our $VERSION = 7.05; +our $VERSION = 8.0; # do not die when receiving sigpipe $SIG{PIPE} = 'IGNORE'; @@ -1260,7 +1260,7 @@ sub mount { $mnt{opts} = /[\(,]ro[\),]/ ? "ro" : "rw"; # acl support is the default unless explicitly disabled $mnt{opts} .= ",acl" if (/[\(,]acl[\),]/ || $acl && !/[\(,]noacl[\),]/); - $mnt{opts} .= ",dmf" if (/[\(,]dm(ap)?i[\),]/); + $mnt{opts} .= ",dmf" if (/[\(,](dmapi|dmi|xdsm)[\),]/); $mnt{opts} .= ",xattr" if (/[\(,]user_xattr[\),]/); #TODO: need to escape local and remote? (my $dev, $mnt{local}, my $type) = ($1, $2, $3) @@ -1291,17 +1291,19 @@ sub mount { $mnt{servers} =~ s/@\w*//g; $mnt{servers} = join("|", map {$_ = fqdn($_)} split(/:/, $mnt{servers})); } elsif ($type eq 'gpfs') { - # gpfs servers do not appear in mount output so call mmlsmgr - my $srv = open3_get([-1, undef, -1], "mmlsmgr $dev"); - # try a default location if not in path - $srv = open3_get([-1, undef, -1], - "/usr/lpp/mmfs/bin/mmlsmgr $dev") if (!$srv); - next if (!defined $srv); - # output is file system then server ip address - if ($srv =~ /^(\w+)\s+(\d+\.\d+\.\d+\.\d+)/m) { - $mnt{remote} = "/$1"; - $mnt{servers} = fqdn($2); + # gpfs servers do not appear in mount output so read config + if (open(FILE, "/var/mmfs/gen/mmfs.cfg")) { + while () { + s/^\s+|\s+$//g; + if (/^clustername\s+(\S+)/i) { + $mnt{servers} = $1; + $mnt{remote} = "/" . $mnt{servers}; + last; + } + } + close FILE; } + next if (!$mnt{servers}); } elsif ($mnt{opts} =~ /,dmf/) { # always report dmf file systems even if local $mnt{servers} = $mnt{host}; diff --git a/perl/shift-mgr b/perl/shift-mgr index 610d78a..affa774 100755 --- a/perl/shift-mgr +++ b/perl/shift-mgr @@ -48,6 +48,11 @@ require Compress::BGZF::Reader; require Compress::BGZF::Writer; use Compress::Zlib; use Data::Dumper; +eval { + # force use of XS variant in case XS version differs from embedded version + require XSLoader; + XSLoader::load('Data::MessagePack'); +}; require Data::MessagePack; use DB_File; use Fcntl qw(:DEFAULT :flock :mode); @@ -72,7 +77,7 @@ use Text::ParseWords; require Tie::DB_FileLock; require Text::FormatTable; -our $VERSION = 7.08; +our $VERSION = 8.0; $Data::Dumper::Pair = " = "; $Data::Dumper::Sortkeys = 1; @@ -143,9 +148,7 @@ my %conf = ( min_streams_wan => 4, min_window_lan => "1m", min_window_wan => "4m", - opts_bbcp => "", opts_bbftp => "", - opts_gridftp => "", opts_mcp => "--double-buffer", opts_msum => "--double-buffer", opts_ssh => "", @@ -164,13 +167,15 @@ my $dbgfh; my $dblock; my $doing; my %ioall; -my %nload; my $localtime = localtime; my @locks; my %meta; +my $monfile; my %mounts; +my %nload; my $self = (gethostbyname(hostname()))[0]; $self = "localhost" if (!$self); +my @stages = qw(chattr cksum cp find ln mkdir sum); my $time = time; my %umounts; my $ustore; @@ -190,6 +195,8 @@ END { close $dbgfh if (defined $dbgfh); # unlock user and transfer directories at program termination lock_dir($_, 1) foreach (0, 1); + # remove monitor file in case user aborts + unlink $monfile if ($monfile); } # parse options @@ -310,14 +317,13 @@ if (defined $opts{put} && !defined $opts{id}) { lock_dir(0, 1); # initialize tells - $meta{$_} = 0 foreach (qw(chattr cksum cp sum tree rtree)); + $meta{$_} = 0 foreach (@stages, 'rmkdir'); # initialize log sizes - $meta{"$_\_size"} = 0 - foreach (qw(alert chattr cksum cp done error meta sum tree)); + $meta{"$_\_size"} = 0 foreach (@stages, qw(alert done error meta)); # initialize done, error, size, and total counts - foreach (qw(chattr cksum cp find ln mkdir sum)) { + foreach (@stages) { $meta{"d_$_"} = 0; $meta{"e_$_"} = 0; $meta{"s_$_"} = 0; @@ -444,7 +450,7 @@ if ($opts{lock}) { exit; } -# retrieve metadata from file +# retrieve metadata from file after possibly (if needed) reverting %meta = %{get_meta()}; # perform requested actions that require only metadata read access @@ -456,7 +462,7 @@ if (defined $opts{status} && $opts{state} eq 'none') { id_status(); exit; } elsif (defined $opts{restart} && !($meta{stop} || $meta{time1} && - sum(map {$meta{"e_$_"}} qw(chattr cksum cp find ln mkdir sum)) > 0)) { + sum(map {$meta{"e_$_"}} @stages) > 0)) { die "Only transfers in stop or error states can be restarted\n"; } elsif (defined $opts{restart} && -e "$opts{base}/no_restart") { open(FILE, '<', "$opts{base}/no_restart"); @@ -513,7 +519,7 @@ if ($opts{alive}) { print "args=stop\n" if ($meta{stop} || $meta{time1}); } elsif (defined $opts{restart}) { # clear counts - $meta{"e_$_"} = 0 foreach (qw(chattr cksum cp find ln mkdir sum)); + $meta{"e_$_"} = 0 foreach (@stages); $meta{$_} = 0 foreach (qw(stop s_run t_run w_run)); delete $meta{time1}; # clear host/client info so clients can be respawned @@ -567,9 +573,6 @@ if ($opts{alive}) { $line = join(" ", map {"$_=$op{$_}"} sort(keys %op)); $cmd = "alert"; $meta{e_alert}++; - } else { - # find retries must go in tree during tar creation - $cmd = "tree" if ($meta{'create-tar'} && $cmd eq 'find'); } # use corresponding queue for all other cases log_print($cmd, $gzs, $line . "\n"); @@ -586,7 +589,6 @@ if ($opts{alive}) { my $fdoing = get_doing($file); while (my ($key, $line) = each %{$fdoing}) { $line =~ s/\s*\r?\n$//; - # put operation in do/tree my %op = split(/[= ]+/, $line); my @args = split(/,/, $op{args}); my $cmd = shift @args; @@ -594,13 +596,11 @@ if ($opts{alive}) { # do not delete hash when retrying cksum delete $op{hash} if ($cmd ne 'cksum'); $line = join(" ", map {"$_=$op{$_}"} sort(keys %op)); - # find retries must go in tree during tar creation - $cmd = "tree" if ($meta{'create-tar'} && $cmd eq 'find'); # use corresponding queue for all other cases log_print($cmd, $gzs, $line . "\n"); } $file =~ s/.*\///; - log_print($file, $gzs, escape(Data::MessagePack->pack({})) . "\n"); + log_print($file, $gzs, yenc_encode(Data::MessagePack->pack({})) . "\n"); } log_close($_, $gzs) foreach (keys %{$gzs}); # transfer may have finished after --restart=ignore @@ -634,7 +634,7 @@ email_status() if ($opts{get} || defined $opts{put}) { # store doing to file my $gzs = {}; - log_print($opts{doing}, $gzs, escape(Data::MessagePack->pack($doing)) . "\n"); + log_print($opts{doing}, $gzs, yenc_encode(Data::MessagePack->pack($doing)) . "\n"); log_close($opts{doing}, $gzs); # update running time average for manager get/put invocations @@ -645,7 +645,7 @@ if ($opts{get} || defined $opts{put}) { # update log sizes foreach my $file (glob "$opts{base}/*") { - next if ($file =~ /\/(?:find|lock|\S+\.gzi)$/); + next if ($file =~ /\/(?:links|lock|mon_\S+|\S+\.gzi)$/); my $log = $file; $log =~ s/.*\///; $meta{"$log\_size"} = (stat $file)[7]; @@ -753,28 +753,28 @@ while (-d "$conf{user_dir}/$more") { $more .= "$opts{user}.more/"; } -#################### -#### build_find #### -#################### -# build tied db of processed directories from entries in tree log -sub build_find { +##################### +#### build_links #### +##################### +# build tied db of processed directories from entries in find log +sub build_links { # remove old db - unlink "$opts{base}/find"; - my %find; - tie(%find, 'DB_File', "$opts{base}/find", O_RDWR | O_CREAT, 0600); + unlink "$opts{base}/links"; + my %links; + tie(%links, 'DB_File', "$opts{base}/links", O_RDWR | O_CREAT, 0600); my $gzs = {}; - while (defined($_ = log_getline('tree', $gzs))) { + while (defined($_ = log_getline('find', $gzs))) { s/\s*\r?\n$//; my %op = split(/[= ]+/, $_); my @args = split(/,/, $op{args}); # only initial finds are used during reconstruction next if ($args[0] ne 'find' || defined $op{try}); - $find{unescape($args[1])} = 1; + $links{unescape($args[1])} = 1; } - log_close('tree', $gzs); - $find{t_find} = $meta{t_find}; - untie %find; - #TODO: error handling if cannot tie or open tree + log_close('find', $gzs); + $links{t_find} = $meta{t_find}; + untie %links; + #TODO: error handling if cannot tie or open find } ##################### @@ -1192,7 +1192,8 @@ sub format_bytes { sub get { # retrieve global and user database from file %mounts = %{mp_retrieve($conf{mount_db})}; - %umounts = %{mp_retrieve($conf{umount_db})} if (!scalar(keys %mounts)); + # do not reload umounts if already done in put() as may have ustore entries + %umounts = %{mp_retrieve($conf{umount_db})} if (!scalar(keys %umounts)); my $warn = delete $meta{"warn_$opts{host}$opts{cid}"}; if ($warn > 0) { @@ -1266,13 +1267,13 @@ sub get { push(@order, splice(@order, 0, ($ihost * $meta{clients} + $icli) % scalar(@order))); # always process chattrs first and dir chattrs last - push(@logs, "chattr", @order, "tree", "rtree"); + push(@logs, qw(chattr ln), @order, qw(mkdir find rmkdir)); } else { # process all copies before all sums before all cksums - push(@logs, qw(tree cp sum cksum chattr rtree)) + push(@logs, qw(find mkdir cp sum cksum ln chattr rmkdir)) } } else { - unshift(@logs, "tree"); + unshift(@logs, "find"); } # keep copy of original doing so changes don't affect its own processing @@ -1280,7 +1281,7 @@ sub get { # reverse size so won't end in 0 (so .N0 not reduced to .N after ++) my $ndoing = "0." . reverse($meta{"$opts{doing}_size"}); my $gzs = {}; - my ($ldoing, $kdoing, $size, $files, $ops, $all, $secs, $skip); + my ($ldoing, $kdoing, $size, $files, $ops, $all, $secs, $skip, $gettry, $getcmd); my $max_files = parse_bytes($conf{max_files}); my (%diskfs, %localfs, %rtthost); my %cli_load = split(/[= ]+/, $meta{"load_$opts{host}$opts{cid}"}); @@ -1289,7 +1290,7 @@ sub get { $opts{interval} = max($meta{interval}, $ncli * $meta{ra_mgr}); LOG: foreach my $log (@logs) { # process dir attrs last by themselves - last if ($log eq 'rtree' && (!$meta{last} || $meta{t_run} || $ops || + last if ($log eq 'rmkdir' && (!$meta{last} || $meta{t_run} || $ops || $skip || (!$meta{sanity} && !$meta{preserve}))); my $line; if ($log eq $opts{doing}) { @@ -1300,24 +1301,26 @@ sub get { log_getline($log, $gzs, 1); next if (!defined $gzs->{$log}); #TODO: need error if cannot be opened or seeked - # seek from end for first rtree since don't have real size - my $whence = $log eq 'rtree' && $meta{$log} == -1 ? 2 : 0; + # seek from end for first rmkdir since don't have real size + my $whence = $log eq 'rmkdir' && $meta{$log} == -1 ? 2 : 0; $gzs->{$log}->seek($meta{$log}, $whence); } while ($all < $max_files && ($secs < $opts{interval} || $size < $meta{size} && $all < $meta{files}) && ($log =~ /^doing_/ && (($kdoing, $line) = each %{$ldoing}) || - $log eq 'rtree' && defined($line = last_line($gzs->{rtree})) || - $log !~ /^(?:doing_|rtree)/ && + $log eq 'rmkdir' && defined($line = last_line($gzs->{rmkdir})) || + $log !~ /^(?:doing_|rmkdir)/ && defined($line = log_getline($log, $gzs)))) { $line =~ s/\s*\r?\n$//; - # first line of rtree will be blank + # first line of rmkdir will be blank next if (!$line); my %op = split(/[= ]+/, $line); my @args = split(/,/, $op{args}); my $cmd = shift @args; my $save_arg = $args[-1]; + # ignore retried entries in rmkdir to avoid duplicate chattrs + next if ($log eq 'rmkdir' && defined $op{try}); # never propagate suspend delete $op{suspend}; if ($log eq $opts{doing}) { @@ -1326,9 +1329,6 @@ sub get { delete $ldoing->{$kdoing}; } - # only mkdirs are used for dir chattrs - next if ($cmd ne 'mkdir' && $log eq 'rtree'); - if ($log =~ /^doing_/ && $op{try} >= $meta{retry}) { # this operation was originally not completed so record failure $meta{s_run} -= $op{size}; @@ -1411,6 +1411,13 @@ sub get { } } + # ensure only one tool will be used per batch + if (!defined $getcmd) { + $getcmd = $cmd; + $gettry = $op{try}; + } + next LOG if ($cmd ne $getcmd || $op{try} ne $gettry); + # process paths again while allowing hash writes my $ir = $args[0] =~ /^\// ? 1 : 0; for (my $i = 0; $i < scalar(@args); $i++) { @@ -1516,7 +1523,7 @@ sub get { # never count mkdir or chattr on dir against the file total $files++ if (scalar(@args) > 1); $size += $op{size} if ($cmd =~ /^(?:cp|sum|cksum)/); - $ops++ if ($log ne 'rtree'); + $ops++ if ($log ne 'rmkdir'); $all++; if ($meta{"ra_$cmd"} > 0) { $secs += ($cmd =~ /^(?:cp|sum|cksum)/ ? @@ -1535,8 +1542,8 @@ sub get { $meta{$log} = tell $gzs->{$log}; } - # rtree is for preserving directory attributes - $cmd = "chattr" if ($log eq 'rtree'); + # rmkdir is for preserving directory attributes + $cmd = "chattr" if ($log eq 'rmkdir'); # rejoin mapped arguments $op{args} = join(",", $cmd, @args); $op{host} = $opts{host}; @@ -1575,12 +1582,12 @@ sub get { } log_close($log, $gzs) if ($log !~ /^doing_/); if ($log ne $opts{doing} && $log =~ /^doing_/) { - log_print($log, $gzs, escape(Data::MessagePack->pack($ldoing)) . "\n"); + log_print($log, $gzs, yenc_encode(Data::MessagePack->pack($ldoing)) . "\n"); log_close($log, $gzs); } } - my $errs = sum(map {$meta{"e_$_"}} qw(chattr cksum cp find ln mkdir sum)); + my $errs = sum(map {$meta{"e_$_"}} @stages); if (!$errs && $meta{last} && !$all && !$meta{t_run} && $meta{tar_mv}) { foreach my $file (grep(/^tar_split_/, keys %meta)) { next if ($meta{$file} != 1); @@ -1629,7 +1636,7 @@ sub get { } # send individual transport options - foreach (qw(bbcp bbftp gridftp mcp msum), + foreach (qw(bbftp mcp msum), $meta{secure} ? "ssh_secure" : "ssh") { my $val = $conf{"opts_$_"}; next if (!$val); @@ -1706,8 +1713,7 @@ sub get { if (grep(/^env_/, keys %meta) < $meta{hosts} || $meta{"clients_$opts{host}"}) { # run client on other/same hosts if there are enough files my $qfiles = $meta{t_split} - $meta{t_run}; - $qfiles += $meta{"t_$_"} - $meta{"d_$_"} - $meta{"e_$_"} - foreach (qw(chattr cksum cp find ln mkdir sum)); + $qfiles += $meta{"t_$_"} - $meta{"d_$_"} - $meta{"e_$_"} foreach (@stages); my $qsize = $meta{s_total} - $meta{s_run} - $meta{s_error}; $qsize += 2 * $meta{s_total} if ($meta{verify}); $qsize -= $meta{"s_$_"} foreach (qw(cksum cp sum)); @@ -1795,7 +1801,7 @@ sub get_doing { $line = last_line($gz) while ($past-- > 0); my $log = basename($arg); log_close($log, {$log => $gz}); - return Data::MessagePack->unpack(unescape($line)) if ($line); + return Data::MessagePack->unpack(yenc_decode($line)) if ($line); return {}; } @@ -1841,7 +1847,7 @@ sub get_meta { if ($meta && defined $mtell && $mtell > 0) { # metadata corrupted so revert to last known good state foreach my $file (glob "$opts{base}/*") { - next if ($file =~ /\/(?:find|lock|meta|\S+\.gzi)$/); + next if ($file =~ /\/(?:links|lock|meta|mon_\S+|\S+\.gzi)$/); my $log = $file; $log =~ s/.*\///; my $size = defined $meta->{"$log\_size"} ? $meta->{"$log\_size"} : 0; @@ -1852,8 +1858,8 @@ sub get_meta { # remove associated index file unlink("$file.gzi"); } - # rebuild find db since it may contain reverted operations - build_find() if ($meta{dereference} && !$meta{'extract-tar'}); + # rebuild link db since it may contain reverted operations + build_links() if ($meta{dereference} && !$meta{'extract-tar'}); # truncate last in case any other operations interrupted truncate($mfile, $mtell); } @@ -1954,8 +1960,8 @@ sub id_status { my $t = dclone($t0); my %files = ( - queue => [qw(cp sum cksum chattr)], - warn => [qw(cp sum cksum chattr)], + queue => [@stages], + warn => [@stages], run => [map {basename $_} glob("$opts{base}/doing_*")], error => ["error"], done => ["done"], @@ -2071,7 +2077,7 @@ sub id_status { sub init_id { # initialize log files if (!defined $opts{restart}) { - log_print($_) foreach (qw(alert chattr cksum cp done error sum tree)); + log_print($_) foreach (@stages, qw(alert done error)); } # initialize options with default values @@ -2177,15 +2183,13 @@ sub lock_dir { # close Compress::BGZF object for given log and remove from given hash sub log_close { my ($log, $gzs) = @_; - # find/ln/mkdir are stored in cp - $log = "cp" if ($log =~ /^(?:find|ln|mkdir)$/); if (defined $gzs->{$log}) { my $bgr = tied *{$gzs->{$log}}; if (ref $bgr eq 'Compress::BGZF::Reader' && defined $bgr->{idx}->[-1]) { my ($coff, $uoff) = @{$bgr->{idx}->[-1]}; - # rtree is just tree in reverse - my $f = $log eq 'rtree' ? 'tree' : $log; + # rmkdir is just mkdir in reverse + my $f = $log eq 'rmkdir' ? 'mkdir' : $log; $f = "$opts{base}/$f.gzi"; local $SIG{__WARN__} = sub {}; # ignore exceptions since gzi is only to increase performance @@ -2207,11 +2211,9 @@ sub log_getline { my ($log, $gzs, $noread) = @_; # untaint $log $log = $1 if ($log =~ /^(\w+)$/); - # find/ln/mkdir are stored in cp - $log = "cp" if ($log =~ /^(?:find|ln|mkdir)$/); if (!defined $gzs->{$log}) { - # rtree is just tree in reverse - my $f = $log eq 'rtree' ? 'tree' : $log; + # rmkdir is just mkdir in reverse + my $f = $log eq 'rmkdir' ? 'mkdir' : $log; # open new reader and store in given hash $gzs->{$log} = Compress::BGZF::Reader->new_filehandle("$opts{base}/$f"); # error conditions will trigger exception @@ -2229,8 +2231,6 @@ sub log_print { my ($log, $gzs, $line) = @_; # untaint $log $log = $1 if ($log =~ /^(\w+)$/); - # find/ln/mkdir are stored in cp - $log = "cp" if ($log =~ /^(?:find|ln|mkdir)$/); if (!defined $line) { log_close($log, $gzs); unlink("$opts{base}/$log.gzi"); @@ -2445,19 +2445,24 @@ sub meta { sub monitor { if ($_[0]) { # find monitor processes - my $fhpid = open3_run([-1, undef, -1], - "ps -o pid,command -u $opts{user}"); - if (defined $fhpid) { - while (defined ($_ = $fhpid->[1]->getline)) { - # do not signal monitors watching other ids - next if (/--id/ && !/--id(\s+|=)$opts{id}/); - # notify processes using SIGCHLD - kill('CHLD', $1) if (/^\s*(\d+).*shift-mgr.*--monitor/); + foreach my $ph (glob "$conf{user_dir}/mon_* $opts{base}/mon_*") { + my $base = basename($ph); + my ($pid, $host); + # untaint pid and host + if ($base =~ /^mon_(\d+)_([\w.-]+)$/) { + ($pid, $host) = ($1, $2); } - open3_wait($fhpid); + # notify processes using SIGCHLD + open3_get([-1, undef, -1], "ssh $host kill -s CHLD $pid"); } return; } + # indicate monitoring for other processes + $monfile = $opts{id} ? $opts{base} : $conf{user_dir}; + $monfile .= join("_", "/mon", $$, $self); + # a failure to create the file will revert to once a minute monitoring + open(FILE, '>', $monfile); + close FILE; # set parameters for status() calls $opts{status} = $opts{monitor}; $opts{state} = "run"; @@ -2488,6 +2493,7 @@ sub monitor { # time is usually only set once upon invocation $time = time; } + # monitor file will be cleaned up by END } ##################### @@ -2617,40 +2623,29 @@ sub parse_bytes { ############## # print output suitable for gnuplot to stdout for selected transfers sub plot { - #TODO: fail={errors, warnings, corruptions, exceptions}, fs - #TODO: not all gnuplots have pdf terminal - #TODO: find not being shown properly? - my $by; - if ($opts{plot} =~ /^(client|fs|host|id|user)$/) { + #TODO: fail={errors, warnings, corruptions, exceptions} + my ($by, $batch); + if ($opts{plot} =~ /^(?:client|fs|host|id|net|user)$/) { ($by, $opts{plot}) = ($opts{plot}, "io"); - } elsif ($opts{plot} =~ /(\S+):(\S+)/) { - ($by, $opts{plot}) = ($1, $2); - die "Can only plot by client, fs, host, id, or user\n" - if ($by !~ /^(client|fs|host|id|user)$/); + } elsif ($opts{plot} =~ /(\S+)([:\/])(\S+)/) { + ($by, $batch, $opts{plot}) = ($1, $2, $3); + $batch = $batch eq ':' ? 0 : 1; + die "Can only plot by client, fs, host, id, net, or user\n" + if ($by !~ /^(?:client|fs|host|id|net|user)$/); } elsif (!$opts{plot}) { $opts{plot} = "io,meta"; } - my @io = $by eq 'fs' ? qw(get put sum cksum) : qw(cp sum cksum); - my $sep = $by ? "+" : ","; - $opts{plot} =~ s/io/join($sep,@io)/eg; - $opts{plot} =~ s/meta/join($sep,qw(find mkdir ln chattr))/eg; - die "Unsupported operation/operator found in plot expression\n" - if ($opts{plot} !~ /^((chattr|cksum|cp|find|get|ln|mkdir|put|sum)([+,]|$))+$/); - # remove trailing operators since above regex doesn't catch - $opts{plot} =~ s/[+,]+$//; - die "Cannot mix io and meta operations in sum expressions\n" - if ($opts{plot} =~ /(chattr|find|ln|mkdir)\+(cksum|cp|sum)/ || - $opts{plot} =~ /(cksum|cp|sum)\+(chattr|find|ln|mkdir)/); + $opts{plot} =~ s/io/join(",",qw(cp sum cksum))/eg; + $opts{plot} =~ s/meta/join(",",qw(find mkdir ln chattr))/eg; + $opts{plot} =~ s/tool/join(",",qw(bbftp fish fish-tcp mcp msum rsync shift-cp shift-sum))/eg; + die "Unsupported term found in plot expression\n" + if ($opts{plot} !~ /^((?:chattr|cksum|cp|find|ln|mkdir|sum|bbftp|fish|fish-tcp|mcp|msum|rsync|shift-cp|shift-sum)(,|$))+$/); + # remove trailing commas since above regex doesn't catch + $opts{plot} =~ s/,+$//; - my %keys; - $keys{$_} = "s_" foreach (@io); - $keys{$_} = "d_" foreach (qw(chattr find ln mkdir)); - - my @cmds = qw(chattr cksum find ln mkdir sum); - push(@cmds, $by eq 'fs' ? qw(get put) : "cp"); my %times; my @metas; - my %seen; + my %items; my $dir = $> != 0 ? $conf{user_dir} : $opts{user_dir}; my $user = $> != 0 ? $opts{user} : "*"; do { @@ -2658,8 +2653,6 @@ sub plot { $dir .= "/*.more"; } while (scalar(glob $dir)); foreach my $file (@metas) { - my $user = $file; - $user =~ s/.*\/([\w-]+)\.\d+\/meta/$1/g; my $id = $file; if ($> != 0) { $id =~ s/.*\.|\/meta//g; @@ -2675,201 +2668,270 @@ sub plot { %meta = %{get_meta($file)}; # skip transfers that use --sync next if ($meta{sync}); - my $state = "run"; - # compute number of operations in various states - my $done = sum(map {$meta{"d_$_"}} qw(chattr cksum cp find ln mkdir sum)); - my $error = sum(map {$meta{"e_$_"}} qw(chattr cksum cp find ln mkdir sum)); - my $total = sum(map {$meta{"t_$_"}} qw(chattr cksum cp find ln mkdir sum)); - # determine transfer state - if ($meta{last} && defined $meta{time1} && $done == $total) { - $state = "done"; - } elsif ($meta{stop}) { - $state = "stop"; - } elsif ($meta{time1}) { - $state = "error"; - } else { - if ($meta{w_run} > 0) { - $state .= "+warn"; - } - if ($error > 0) { - $state .= "+error"; - } - if (grep(/^throttled_/, keys(%meta))) { - $state .= "+throttle"; - } - } - $state .= "+alert" if ($meta{e_alert} || $meta{e_silent}); + my $state = state(); # skip transfers that do not match the given state next if (!$opts{id} && $opts{state} && $state !~ /(?:^|\+)\Q$opts{state}\E(?:$|\+)/); + + my $group; + if ($by eq 'id') { + $group = $id; + } elsif ($by eq 'user') { + $group = $file; + $group =~ s/.*\/([\w-]+)\.\d+\/meta/$1/g; + } + my %gets; - my $meta0; + my ($meta0, $meta); + my ($time0, $time1); my $fh; open($fh, '<', $file) or die; while (my $line = <$fh>) { last if (!defined $line); last if (substr($line, 0, 1) != '[' || substr($line, -1, 1) != ']'); + $meta0 = $meta; # note that this doesn't handle Math::BigInt as is normally done - my $meta = eval {Data::MessagePack->unpack(uncompress( + $meta = eval {Data::MessagePack->unpack(uncompress( yenc_decode(substr($line, 1, -1))))}; next if (!$meta); my $client = $meta->{update_id}; my $host = $client; $host =~ s/\.\d+$//; my $last = "last_$host"; - next if ($meta0->{$last} == $meta->{$last}); - my $time = $meta->{$last}; + my $ltime = $meta->{$last}; + + if (!defined $time0) { + # skip times that were too far in the past and will clutter plot + next if ($> == 0 && $ltime + $conf{data_expire} < $time); + # ensure start time is added for difference to first operation + $time0 = $ltime; + $times{$time0} = [] if (!defined $times{$time0}); + } + if (!defined $time1 && $meta->{time1}) { + # ensure start time is added for difference to last operation + $time1 = $meta->{time1}; + $times{$time1} = [] if (!defined $times{$time1}); + } # record rates when hosts have completed operations (put) if ($gets{$client} && - sum(map {$meta->{"$_\_size"}} qw(chattr cksum cp done error sum tree)) > - sum(map {$meta0->{"$_\_size"}} qw(chattr cksum cp done error sum tree))) { + sum(map {$meta->{"$_\_size"}} (@stages, qw(done error))) > + sum(map {$meta0->{"$_\_size"}} (@stages, qw(done error)))) { my %fs; if ($by eq 'fs') { - foreach my $cmd (@cmds) { - foreach (grep(/^$keys{$cmd}${cmd}_/, keys %{$meta})) { - s/^$keys{$cmd}${cmd}_//; - # ignore _size metadata - next if ($_ eq 'size'); - $fs{$_} = 1; - } + # find all file systems in use + foreach (grep(/^[ds]_(?:chattr|cksum|find|get|ln|mkdir|put|sum)_/, + keys %{$meta})) { + s/^\w+_\w+_//; + $fs{$_} = 1; } } else { $fs{""} = 1; } - foreach my $fs (keys %fs) { - my $data; - foreach my $cmd (@cmds) { - my $fscmd = $keys{$cmd} . $cmd; - $fscmd .= "_$fs" if ($fs); - my $rate = $meta->{$fscmd} - $meta0->{$fscmd}; - # io operations are shown in MB/s - $rate /= 1E6 if ($keys{$cmd} eq 's_'); - # throw out negative results due to retries - $rate = 0 if ($rate < 0); - $data->{$cmd} = ceil($rate / ($time - $gets{$client})); + if ($by eq 'client') { + $group = $client; + } elsif ($by eq 'host') { + $group = $host; + } elsif ($by eq 'net') { + $group = "unknown"; + if ($meta->{origin_ip}) { + # change origin to subnet + $group = $meta{origin_ip}; + $group =~ s/\.\d+$/\.0/; } - if (defined $data) { - # add to operations if something done (i.e. not --alive) - $times{$gets{$client}} = [] - if (!defined $times{$gets{$client}}); - $times{$time} = [] if (!defined $times{$time}); - $data->{user} = $user; - $data->{id} = $id; - $data->{host} = $host; - $data->{client} = $client; - $data->{fs} = $fs; - # computed rates begin when the get occurred - push(@{$times{$gets{$client}}}, $data); + } + foreach my $fs (keys %fs) { + if ($by eq 'fs') { + # remove all but server mount point + my $f = $fs; + $f =~ s/^[^\/]*//; + $group = $fs ? $f : "unknown"; + } + my $data; + foreach my $cmd (split(/,/, $opts{plot})) { + my ($count, $rate); + if ($cmd eq 'find') { + # use number of operations generated as rate basis + # (this is inaccurate when #fs>1 in a find batch) + $rate = sum(map {$meta->{"t_$_"} - $meta0->{"t_$_"}} qw(cp ln mkdir)); + } elsif ($cmd =~ /^(?:chattr|cksum|ln|mkdir|sum)$/) { + my $fscmd = "d_$cmd"; + if ($cmd =~ /sum$/) { + $count = $meta->{$fscmd} - $meta0->{$fscmd}; + $fscmd = "s_$cmd"; + } + $fscmd .= "_$fs" if ($fs); + $rate = $meta->{$fscmd} - $meta0->{$fscmd}; + # io operations are shown in MB/s + $rate /= 1E6 if ($cmd =~ /sum$/); + } else { + $count = $meta->{"d_$cmd"} - $meta0->{"d_$cmd"}; + next if ($count <= 0); + # this assumes one tool per batch (get() ensures) + my @fscmds = $cmd =~ /sum$/ ? qw(cksum sum) : + ($fs ? qw(get put) : qw(cp)); + # msum and shift-sum + foreach my $fscmd (@fscmds) { + $fscmd = "s_$fscmd"; + $fscmd .= "_$fs" if ($fs); + $rate += $meta->{$fscmd} - $meta0->{$fscmd}; + } + # io operations are shown in MB/s + $rate /= 1E6; + } + # throw out negative results due to retries + next if ($rate <= 0); + my $tdiff = $ltime - $gets{$client}; + $tdiff = 1 if (!$tdiff); + $data->{$cmd} = ceil($rate / $tdiff); + # add batch size as negligible fraction + $data->{$cmd} .= ".00$count" if ($batch && $count > 0); + } + next if (!defined $data); + + # add to operations if something done (i.e. not --alive) + $times{$gets{$client}} = [] + if (!defined $times{$gets{$client}}); + $times{$ltime} = [] if (!defined $times{$ltime}); + + foreach (keys %{$data}) { + my $key = $_; + $key = "$group [$key]" if ($by); + $items{$key} = 1; + } + $data->{group} = $group if ($by); + + if ($batch) { + $data->{time} = $ltime; + } elsif (!$batch) { # computed rates end when the put occurred my $data2 = dclone($data); - $data2->{$_} *= -1 foreach (@cmds); - push(@{$times{$time}}, $data2); - # record id/host/user for creation of header/data rows - $seen{user}->{$user} = 1; - $seen{id}->{$id} = 1; - $seen{host}->{$host} = 1; - $seen{client}->{$client} = 1; - $seen{fs}->{$fs} = 1; + foreach (split(/,/, $opts{plot})) { + $data2->{$_} *= -1; + } + push(@{$times{$ltime}}, $data2); } + # computed rates begin when the get occurred + push(@{$times{$gets{$client}}}, $data); } # no more outstanding operations by client delete $gets{$client}; } # record when clients have operations in progress (get) - $gets{$client} = $time + $gets{$client} = $ltime if ($meta->{"doing_$client\_size"} > $meta0->{"doing_$client\_size"}); - $meta0 = $meta; } close $fh; } - my @header; - if ($by) { - foreach my $col (sort(split(/,/, $opts{plot}))) { - foreach my $group (sort(keys %{$seen{$by}})) { - push(@header, "[$col] $group"); - } - } - } else { - @header = split(/,/, $opts{plot}); - } + my @items = sort(keys %items); + die "No suitable transfers to plot\n" if (!scalar(@items)); # embed data inline so output can be piped directly into gnuplot print "# This output requires gnuplot version 5 or higher\n"; - print '$data << EOF', "\n"; - print join(" ", "time", map {"\"$_\""} @header), "\n"; + print '$data << EOD', "\n"; - my ($time0, $time1); - my %vals = map {$_ => 0} @header; - # ensure all initial rates are zero - print join(" ", 0, values %vals), "\n"; - foreach my $time (sort {$a <=> $b} keys(%times)) { - # record first time witnessed - $time0 = $time if (!defined $time0); - foreach my $val (@{$times{$time}}) { - for (my $i = 0; $i < scalar(@header); $i++) { - my $head = $header[$i]; - my ($col, $group) = split(/\s/, $head); - next if ($by && $val->{$by} ne $group); - $col =~ s/^[[]|[]]$//g; - my @adds = split(/\+/, $col); - foreach my $add (@adds) { - $vals{$head} += $val->{$add}; + my $time1; + my %vals; + my %stats; + my $sum; + my %sums; + foreach my $ltime (sort {$a <=> $b} keys(%times)) { + if (!$batch && $time1) { + foreach my $group (keys %vals) { + while (my ($k, $v) = each %{$vals{$group}}) { + next if ($v <= 0); + $k = "$group [$k]" if ($group); + print join(" ", $time1, $ltime, "\"$k\"", $v), "\n"; + $stats{n}++; + $stats{s} += $v; + $stats{sq} += $v * $v; } } } - # populate adjusted time and data columns - print join(" ", $time - $time0, map {$vals{$_}} @header), "\n"; + foreach my $val (@{$times{$ltime}}) { + my ($group, $t) = delete @{$val}{qw(group time)}; + while (my ($k, $v) = each %{$val}) { + if ($batch) { + $k = "$group [$k]" if ($group); + print join(" ", $ltime, $t, "\"$k\"", $v), "\n"; + $stats{n}++; + $stats{s} += $v; + $stats{sq} += $v * $v; + } else { + $vals{$group}->{$k} += $v; + $sum->{$k} += $v; + } + } + } + $sums{$ltime} = dclone($sum) if (!$batch && ref $sum); # record last time witnessed - $time1 = $time; + $time1 = $ltime; } - # ensure all final rates are zero - print join(" ", $time1 - $time0, map {0} @header), "\n"; - print "EOF\n"; + print "EOD\n"; + + if (!$batch) { + print '$max << EOD', "\n"; + my @sums = sort {$a <=> $b} keys(%sums); + my $t0 = $sums[0]; + my $tdiff = int(($time1 - $t0) / 100); + $tdiff = 1 if (!$tdiff); + my @max = (0, 0); + foreach my $ltime (@sums) { + if ($ltime >= $t0 + $tdiff && $max[0] + $max[1] > 0) { + print "$t0 $max[0] $max[1]\n"; + $t0 = $t0 + $tdiff; + @max = (0, 0); + } + my @max1; + while (my ($k, $v) = each %{$sums{$ltime}}) { + my $io = $k =~ /^(?:find|mkdir|ln|chattr)$/ ? 1 : 0; + $max1[$io] += $v; + } + foreach (0, 1) { + $max[$_] = $max1[$_] if ($max1[$_] > $max[$_]); + } + } + print "EOD\n"; + } + + if ($stats{n}) { + $stats{m} = $stats{s} / $stats{n}; + $stats{dev} = sqrt($stats{sq} / $stats{n} - ($stats{s} / $stats{n})**2); + } + my $lw = "lw " . min(10, max(.75, (50 / scalar(@items)))); + my $font = "font '," . max(2, min(10, ceil(300 / scalar(@items)))) . "'"; + my $ps = "ps " . min(1, max(.075, (5 / scalar(@items)))); + my $td = 3600 * ((24 + (gmtime($time))[2] - (localtime($time))[2]) % 24); # set basic plot characteristics print "set terminal pdf enhanced\n"; - print "set xlabel 'Time (s)' textcolor rgb 'white'\n"; print "set border linecolor rgb 'white'\n"; - print "set key Left reverse font ',6' outside textcolor rgb 'white'\n"; + print "set format x '%m/%d %H:%M:%S'\n"; + print "set lmargin at screen .15\n"; print "set obj 1 rect behind from screen 0,0 to screen 1,1 fillcolor rgb 'black' behind\n"; - my $unit = $opts{plot} =~ /cksum|cp|sum/ ? "MB" : "ops"; - my $type = $opts{plot} =~ /cksum|cp|sum/ ? "I/O" : "Meta"; - print "set ylabel '$type performance ($unit/s)' textcolor rgb 'white'\n"; - - # set color of each data column (based on savors palette) - my @palette = qw( - FF0000 FF7F00 FFFF00 80FF00 00FF00 00FFFF 0080FF 0000FF 7F00FF FF00FF FF007F - CC0000 CC6600 CCCC00 66CC00 00CC00 00CCCC 0066CC 0000CC 6600CC CC00CC CC0066 - 990000 994C00 999900 4D9900 009900 009999 004C99 000099 4D0099 990099 99004D - FF7F7F FFBF80 FFFF7F BFFF80 80FF80 80FFFF 80BFFF 807FFF BF7FFF FF7FFF FF7FBF - CC6666 CC9966 CCCC66 99CC66 66CC66 66CCCC 6699CC 6666CC 9966CC CC66CC CC6699 - 994C4D 99734C 99994D 73994D 4D994D 4D9999 4D7399 4D4C99 734C99 994C99 994C73 - FFBFBF FFDFBF FFFFBF DFFFBF BFFFBF BFFFFF BFDFFF BFBFFF DFBFFF FFBFFF FFBFDF - CC9999 CCB399 CCCC99 B3CC99 99CC99 99CCCC 99B2CC 9999CC B399CC CC99CC CC99B3 - ); - foreach my $i (2 .. scalar(@header) + 1) { - print "set style line $i linecolor rgb '#", - # reuse colors when more columns than palette colors - $palette[($i - 2) % scalar(@palette)], "'\n"; - } - - if ($opts{plot} =~ /chattr|find|ln|mkdir/ && - $opts{plot} =~ /cksum|cp|sum/) { - # set up dual y-axes when plotting both io and meta operations - print "set ytics nomirror\n"; - print "set y2tics nomirror\n"; - print "set y2range [0:]\n"; - print "set y2label 'Meta performance (ops/s)' textcolor rgb 'white'\n"; - } + print "set palette defined ( 0 '#2f0087', 1 '#6200a4', 2 '#9200a6', 3 '#ba2f8a', 4 '#d85b69', 5 '#ee8949', 6 '#f6bd27', 7 '#e4fa15' )\n"; + print "set style arrow 1 nohead lc palette $lw\n"; + print "set timefmt '%s'\n"; + print "set xdata time\n"; + print "set xlabel 'Time' textcolor rgb 'white' offset screen 0,.05\n"; + print "set xtics nomirror rotate by 60 right font ',6'\n"; + print "set ytics nomirror $font\n"; + print "unset key\n"; + print "set ylabel 'Rate (I/O: MB/s, Meta: ops/s)' textcolor rgb 'white'\n"; + print "set y2tics nomirror\n" if (!$batch); + my $lc = $stats{m}+2 * $stats{dev}; + print "lc(x) = x > $lc ? $lc : x\n"; + print "set yrange [.5:", scalar(@items) + .5, "]\n"; + print "item(i) = ", join(" : ", map {"(i eq \"$items[-$_]\" ? $_"} + (1..scalar(@items))), " : -1", ")" x scalar(@items), "\n"; print "plot \\\n"; - my $i = 2; - foreach my $head (@header) { - my $axis = $head =~ /cksum|cp|sum/ ? "" : " axes x1y2"; - print " \$data using 1:$i ti columnheader($i) with steps ls $i$axis"; - $i++; - print ",\\\n" if ($i < scalar(@header) + 2); + if ($batch) { + print " \$data using (\$1-$td):(item(strcol(3))):(lc(\$4)):ytic(3) with points lc palette pt 7 $ps\n"; + } else { + print " \$data using (\$1-$td):(item(strcol(3))):(\$2-\$1):(0):(lc(\$4)):ytic(3) with vector as 1, \\\n"; + print " \$max using (\$1-$td):2 axes x1y2 with points lc \"green\" pt 7 ps .075, \\\n"; + print " \$max using (\$1-$td):3 axes x1y2 with points lc \"blue\" pt 7 ps .075\n"; } print "\n"; } @@ -2880,7 +2942,7 @@ sub plot { # record the state of file operations that were processed by a client sub put { # only process a put when the corresponding get was from this host - return if ($opts{put} && $opts{put} ne $self); + return if ($opts{put} && $opts{put} ne $self && $conf{sync_host}); # retrieve global and user database from file %mounts = %{mp_retrieve($conf{mount_db})}; %umounts = %{mp_retrieve($conf{umount_db})}; @@ -2888,7 +2950,7 @@ sub put { my $gzs = {}; my $more_finds = $opts{more_finds} + $meta{d_find} + $meta{e_find} == $meta{t_find} ? 0 : 1; - my %find; + my %links; my %mnts; my %rates; $meta{"warn_$opts{host}$opts{cid}"} = -1; @@ -3071,9 +3133,7 @@ sub put { $cmd = "cksum"; $op{args} =~ s/^[^,]+/$cmd/; } elsif (($meta{sanity} || $meta{preserve}) && - ($cmd =~ /^(?:cksum|cp|ln)/ || - # tar mkdirs are not put in tree so are not handled by rtree - $cmd eq 'mkdir' && $meta{'create-tar'})) { + $cmd =~ /^(?:cksum|cp|ln)/) { if ($meta{silent} && $cmd eq 'cksum' && detect_silent(\%op, $args[0], $args[1])) { $line =~ s/(?:text|tool)=\S+//g; @@ -3313,9 +3373,7 @@ sub put { # do not delete hash when retrying cksum delete $op{hash} if ($op{args} !~ /^cksum/); $line = join(" ", map {"$_=$op{$_}"} sort(keys %op)); - # find retries must go in tree during tar creation - my $log = $cmd eq 'find' && $meta{'create-tar'} ? "tree" : $cmd; - log_print($log, $gzs, "$line\n"); + log_print($cmd, $gzs, "$line\n"); } elsif (defined $op{size}) { $meta{"t_$cmd"}++; $meta{t_chattr}++ if ($meta{sanity} || $meta{preserve}); @@ -3391,8 +3449,8 @@ sub put { $meta{"tar_size_$tar"} >= $meta{'split-tar'}) { # indicate last tar entry so final padding can be added $op{tar_last} = 1; - # insert chattr op in tree to preallocate and stripe - log_print('tree', $gzs, "args=chattr,$tar-" . + # insert chattr op in find to preallocate and stripe + log_print('find', $gzs, "args=chattr,$tar-" . $meta{"tar_split_$tar"} . ".tar host=$opts{host}" . " tar_creat=" . $meta{"tar_size_$tar"} . "\n"); $meta{t_chattr}++; @@ -3405,9 +3463,8 @@ sub put { $line = join(" ", map {"$_=$op{$_}"} sort(keys %op)); } - if ($cmd eq 'mkdir') { - my $log = $meta{'create-tar'} ? $cmd : "tree"; - log_print($log, $gzs, "$line\n"); + if ($cmd eq 'ln' || $cmd eq 'mkdir') { + log_print($cmd, $gzs, "$line\n"); } elsif ($cmd eq 'cp') { $meta{s_total} += $op{size}; if ($meta{verify}) { @@ -3464,23 +3521,23 @@ sub put { } elsif ($cmd eq 'find') { if ($meta{dereference} && !$meta{'extract-tar'}) { # these conditions are only valid after getopt lines processed - if (!defined $find{t_find}) { - tie(%find, 'DB_File', "$opts{base}/find", O_RDWR, 0600); - if (!defined $find{t_find} || $find{t_find} != $meta{t_find}) { + if (!defined $links{t_find}) { + tie(%links, 'DB_File', "$opts{base}/links", O_RDWR, 0600); + if (!defined $links{t_find} || $links{t_find} != $meta{t_find}) { # this can happen when mgr fails over as find not sync'd - untie %find; - build_find(); - tie(%find, 'DB_File', "$opts{base}/find", O_RDWR, 0600); + untie %links; + build_links(); + tie(%links, 'DB_File', "$opts{base}/links", O_RDWR, 0600); } #TODO: need error if cannot be tied } # skip src directories already processed due to symlinks - next if ($find{$args[0]}); - $find{$args[0]} = 1; - $find{t_find}++; + next if ($links{$args[0]}); + $links{$args[0]} = 1; + $links{t_find}++; } $meta{"t_$cmd"}++; - log_print('tree', $gzs, "$line\n"); + log_print('find', $gzs, "$line\n"); } elsif ($cmd eq 'mount') { $mnts{$line} = \%op; } elsif ($cmd eq 'shell') { @@ -3503,8 +3560,8 @@ sub put { # use chattr to track additional move $meta{t_chattr}++; } - # insert chattr op in tree to preallocate and stripe - log_print('tree', $gzs, "args=chattr,$file-$split.tar " . + # insert chattr op in find to preallocate and stripe + log_print('find', $gzs, "args=chattr,$file-$split.tar " . "host=$opts{host} tar_creat=$size\n"); $meta{t_chattr}++; $meta{tar_creat}++; @@ -3513,15 +3570,15 @@ sub put { # close log files log_close($_, $gzs) foreach (keys %{$gzs}); - untie %find if (defined $find{t_find}); + untie %links if (defined $links{t_find}); if ($more_finds && $meta{d_find} + $meta{e_find} == $meta{t_find}) { # non-tar transition from finds outstanding to no finds outstanding if ($meta{e_find} + $meta{t_cp} + $meta{t_ln} + $meta{t_mkdir} == 0) { # force error if no files (e.g. non-matching --include) - # use first tree line (should be find) for error line - my $line = log_getline('tree', $gzs); - log_close('tree', $gzs); + # use first find line for error line + my $line = log_getline('find', $gzs); + log_close('find', $gzs); chomp $line; # this should never happen if client/manager versions match $line = "args=find,no_src,no_dst host=no_host" if (!$line); @@ -3532,8 +3589,8 @@ sub put { } elsif (!$meta{e_find}) { # mark initialization done $meta{last} = 1; - # initialize rtree size (use -1 for later special seek) - $meta{rtree} = -1; + # initialize rmkdir size (use -1 for later special seek) + $meta{rmkdir} = -1; } # mark transfers complete if no files after find $meta{time1} = $time if (!run()); @@ -3616,13 +3673,13 @@ sub run { $expect += $meta{"d_$_"} foreach (qw(cp ln)); # expect dir chattrs only when tar create or no other errors my $errs = sum(map {$meta{"e_$_"}} qw(cp find ln mkdir)); - # when errs > 0 and rtree == 0, any chattr errors are from dirs + # when errs > 0 and rmkdir == 0, any chattr errors are from dirs # and not files, so should still expect t_mkdir dir chattrs - $expect += $echattr + $errs && $meta{rtree} && !$meta{'create-tar'} ? + $expect += $echattr + $errs && $meta{rmkdir} && !$meta{'create-tar'} ? 0 : $meta{t_mkdir}; } - my $actual = sum(map {$meta{"d_$_"}} qw(chattr cksum cp find ln mkdir sum)); - my $errs = sum(map {$meta{"e_$_"}} qw(chattr cksum cp find ln mkdir sum)); + my $actual = sum(map {$meta{"d_$_"}} @stages); + my $errs = sum(map {$meta{"e_$_"}} @stages); $actual += $errs; # expect tar_mv chattrs only when no other errors $expect += $echattr + $errs - $meta{e_chattr} ? 0 : $meta{tar_mv}; @@ -3630,6 +3687,40 @@ sub run { return ($expect != $actual); } +############### +#### state #### +############### +# return state of current/given transfer +sub state { + my $meta0 = shift; + $meta0 = \%meta if (!defined $meta0); + my $state = "run"; + # compute number of operations in various states + my $done = sum(map {$meta{"d_$_"}} @stages); + my $error = sum(map {$meta{"e_$_"}} @stages); + my $total = sum(map {$meta{"t_$_"}} @stages); + # determine transfer state + if ($meta{last} && defined $meta{time1} && $done == $total) { + $state = "done"; + } elsif ($meta{stop}) { + $state = "stop"; + } elsif ($meta{time1}) { + $state = "error"; + } else { + if ($meta{w_run} > 0) { + $state .= "+warn"; + } + if ($error > 0) { + $state .= "+error"; + } + if (grep(/^throttled_/, keys(%meta))) { + $state .= "+throttle"; + } + } + $state .= "+alert" if ($meta{e_alert} || $meta{e_silent}); + return $state; +} + ############### #### stats #### ############### @@ -3648,8 +3739,8 @@ sub stats { [qw(local_min local_max local_avg lan_min lan_max lan_avg wan_min wan_max wan_avg all_min all_max all_avg)], Tools => - [qw(bbcp bbftp fish fish-tcp gridftp mcp msum rsync shift-chattr - shift-cp shift-find shift-sum)], + [qw(bbftp fish fish-tcp mcp msum rsync shift-chattr shift-cp + shift-find shift-sum)], Options_1 => [qw(bandwidth buffer clients cpu create-tar exclude extract-tar files force host-list hosts include index-tar interval)], @@ -3721,18 +3812,18 @@ sub stats { # skip transfers that have not completed next if (!$meta{time1}); - my %totals; - # transfer totals - $totals{attrs} = $meta{d_chattr}; - $totals{hosts} = grep(/^last_/, keys %meta); - $totals{dirs} = $meta{d_mkdir}; - $totals{files} = $meta{d_cp} + $meta{d_ln}; - $totals{size} = $meta{s_cp}; - $totals{ssize} = $meta{s_sum} + $meta{s_cksum}; - $totals{sums} = $meta{d_sum} + $meta{d_cksum}; - $totals{xfers} = 1; - $totals{$type} = 1; + my %totals = ( + attrs => $meta{d_chattr}, + hosts => scalar(grep(/^last_/, keys %meta)), + dirs => $meta{d_mkdir}, + files => $meta{d_cp} + $meta{d_ln}, + size => $meta{s_cp}, + ssize => $meta{s_sum} + $meta{s_cksum}, + sums => $meta{d_sum} + $meta{d_cksum}, + xfers => 1, + $type => 1, + ); # tool operation totals and tool error totals foreach (@{$heads{Tools}}) { @@ -3766,9 +3857,7 @@ sub stats { } # error totals (corruption/exception/silent handled earlier) - foreach (qw(chattr cksum cp find ln mkdir sum)) { - $totals{"e_$_"} = $meta{"e_$_"}; - } + $totals{"e_$_"} = $meta{"e_$_"} foreach (@stages); $totals{e_host} = grep(/^nohost_/, keys %meta); # add transfer stats to totals per user, per type, and overall @@ -3982,12 +4071,16 @@ sub status { my @metas; my @rows; my $dones; - my $dir = $> != 0 ? $conf{user_dir} : $opts{user_dir}; - my $user = $> != 0 ? $opts{user} : "*"; - do { - push(@metas, glob "$dir/$user.[0-9]*/meta"); - $dir .= "/*.more"; - } while (scalar(glob $dir)); + if ($opts{id}) { + @metas = ("$opts{base}/meta"); + } else { + my $dir = $> != 0 ? $conf{user_dir} : $opts{user_dir}; + my $user = $> != 0 ? $opts{user} : "*"; + do { + push(@metas, glob "$dir/$user.[0-9]*/meta"); + $dir .= "/*.more"; + } while (scalar(glob $dir)); + } foreach my $file (sort {$> != 0 && !defined $opts{monitor} ? # sort by user name when root or --monitor invocation (stat $a)[9] <=> (stat $b)[9] : $a <=> $b} @metas) { @@ -4000,51 +4093,27 @@ sub status { # leave user name in id $id =~ s/.*\/([\w-]+\.\d+)\/meta/$1/g; } - if ($opts{id}) { - # ignore other ids when id is defined - next if ($id != $opts{id}); - } else { - # retrieve metadata from file - %meta = %{get_meta($file)}; - } - my $time1 = defined $meta{time1} ? $meta{time1} : $time; - my $state = "run"; + # retrieve metadata from file + %meta = %{get_meta($file)} if (!$opts{id} || $opts{monitor}); + my $state = state(); my $color = "green"; - # compute number of operations in various states - my $done = sum(map {$meta{"d_$_"}} qw(chattr cksum cp find ln mkdir sum)); - my $error = sum(map {$meta{"e_$_"}} qw(chattr cksum cp find ln mkdir sum)); - my $total = sum(map {$meta{"t_$_"}} qw(chattr cksum cp find ln mkdir sum)); - # determine transfer state - if ($meta{last} && defined $meta{time1} && $done == $total) { - $state = "done"; - $color = "reset"; + if ($state =~ /done/) { + $color = $state eq 'done+alert' ? "magenta" : "reset"; $dones++; - } elsif ($meta{stop}) { - $state = "stop"; + } elsif ($state eq 'error') { + $color = "red"; + } elsif ($state eq 'stop') { my $base = $file; $base =~ s/(\/[^\/]+.more|meta)//g; $color = (-e "${base}no_restart" ? "bold " : "") . "cyan"; - } elsif ($meta{time1}) { - $state = "error"; - $color = "red"; - } else { - if ($meta{w_run} > 0) { - $state .= "+warn"; - $color = "yellow"; - } - if ($error > 0) { - $state .= "+error"; - $color = "yellow"; - } - if (grep(/^throttled_/, keys(%meta))) { - $state .= "+throttle"; - $color = "blue" if ($color ne 'yellow'); - } + } elsif ($state =~ /warn|error/) { + $color = "yellow"; + } elsif ($state =~ /throttle/) { + $color = "blue"; } - $state .= "+alert" if ($meta{e_alert} || $meta{e_silent}); - $color = "magenta" if ($state eq 'done+alert'); # skip transfers that do not match the given state next if ($opts{state} && $state !~ /(?:^|\+)\Q$opts{state}\E(?:$|\+)/); + my $time1 = defined $meta{time1} ? $meta{time1} : $time; # add first row for each transfer with bulk of info my $rate = $time1 - $meta{time0} ? $meta{s_cp} / ($time1 - $meta{time0}) : $meta{s_cp}; @@ -4242,8 +4311,8 @@ sub sync_local { #TODO: add meta to end of this and remove final meta part foreach my $file (keys %files) { - # find must be rebuilt and meta is done separately - next if ($file =~ /(?:find|meta)$/); + # links must be rebuilt and meta is done separately + next if ($file =~ /(?:links|meta|mon_\S+)$/); my $off = $fmeta->{basename($file) . "_size"}; $off = 0 if (!defined $off); my ($mode, $size) = @{$files{$file}}; @@ -4807,43 +4876,23 @@ sub unescape { ##################### #### yenc_decode #### ##################### -# based on Data::BISON::yEnc by Andy Armstrong (artistic license) +# based on Convert::BulkDecoder by Johan Vromans (artistic license) sub yenc_decode { - my $data = shift; - my @data = map {ord $_} split(//, $data); - my @out; - while (defined(my $byte = shift @data)) { - next if ($byte == 0x00 || $byte == 0x0A || $byte == 0x0D || - # add [ and ] to normal yEnc encoding - $byte == 0x5B || $byte == 0x5D); - if ($byte == 0x3D) { - my $next = shift @data; - $byte = ($next - 64) & 0xFF; - } - push(@out, ($byte - 42) & 0xFF); - } - return join("", map {chr $_} @out); + $_ = shift; + s/=(.)/chr(ord($1) + (256 - 64) & 255)/ge; + tr{\000-\377}{\326-\377\000-\325}; + return $_; } ##################### #### yenc_encode #### ##################### -# based on Data::BISON::yEnc by Andy Armstrong (artistic license) +# based on Convert::BulkDecoder by Johan Vromans (artistic license) sub yenc_encode { - my $data = shift; - my @data = map {ord $_} split(//, $data); - my @out; - while (defined(my $byte = shift @data)) { - my $rep = ($byte + 42) & 0xFF; - if ($rep == 0x00 || $rep == 0x0A || $rep == 0x0D || $rep == 0x3D || - # add [ and ] to normal yEnc encoding - $rep == 0x5B || $rep == 0x5D) { - push @out, 0x3D; - $rep = ($rep + 64) & 0xFF; - } - push(@out, $rep); - } - return join("", map {chr $_} @out); + $_ = shift; + tr{\326-\377\000-\325}{\000-\377}; + s/([\x00\x0A\x0D\x3D\x5B\x5D])/"=" . chr(ord($1) + 64 & 255)/ge; + return $_; } # This chunk of stuff was generated by App::FatPacker. To find the original @@ -4864,7 +4913,7 @@ $fatpacked{"Compress/BGZF/Writer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\ COMPRESS_BGZF_WRITER $fatpacked{"Data/MessagePack.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MESSAGEPACK'; - package Data::MessagePack;use strict;use warnings;use 5.008001;our$VERSION='1.00';sub true () {require Data::MessagePack::Boolean;no warnings 'once';return$Data::MessagePack::Boolean::true}sub false () {require Data::MessagePack::Boolean;no warnings 'once';return$Data::MessagePack::Boolean::false}if (!__PACKAGE__->can('pack')){my$backend=$ENV{PERL_DATA_MESSAGEPACK}|| ($ENV{PERL_ONLY}? 'pp' : '');if ($backend !~ /\b pp \b/xms){eval {require XSLoader;XSLoader::load(__PACKAGE__,$VERSION)};die $@ if $@ && $backend =~ /\b xs \b/xms}if (!__PACKAGE__->can('pack')){require 'Data/MessagePack/PP.pm'}}sub new {my($class,%args)=@_;return bless \%args,$class}for my$name(qw(canonical prefer_integer utf8)){my$setter=sub {my($self,$value)=@_;$self->{$name}=defined($value)? $value : 1;return$self};my$getter=sub {my($self)=@_;return$self->{$name}};no strict 'refs';*{$name}=$setter;*{'get_' .$name}=$getter}sub encode;*encode=__PACKAGE__->can('pack');sub decode;*decode=__PACKAGE__->can('unpack');1; + package Data::MessagePack;use strict;use warnings;use 5.008001;our$VERSION='1.01';sub true () {require Data::MessagePack::Boolean;no warnings 'once';return$Data::MessagePack::Boolean::true}sub false () {require Data::MessagePack::Boolean;no warnings 'once';return$Data::MessagePack::Boolean::false}if (!__PACKAGE__->can('pack')){my$backend=$ENV{PERL_DATA_MESSAGEPACK}|| ($ENV{PERL_ONLY}? 'pp' : '');if ($backend !~ /\b pp \b/xms){eval {require XSLoader;XSLoader::load(__PACKAGE__,$VERSION)};die $@ if $@ && $backend =~ /\b xs \b/xms}if (!__PACKAGE__->can('pack')){require 'Data/MessagePack/PP.pm'}}sub new {my($class,%args)=@_;return bless \%args,$class}for my$name(qw(canonical prefer_integer utf8)){my$setter=sub {my($self,$value)=@_;$self->{$name}=defined($value)? $value : 1;return$self};my$getter=sub {my($self)=@_;return$self->{$name}};no strict 'refs';*{$name}=$setter;*{'get_' .$name}=$getter}sub encode;*encode=__PACKAGE__->can('pack');sub decode;*decode=__PACKAGE__->can('unpack');1; DATA_MESSAGEPACK $fatpacked{"Data/MessagePack/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_MESSAGEPACK_BOOLEAN'; diff --git a/perl/shiftc b/perl/shiftc index ff436e2..7a7678a 100755 --- a/perl/shiftc +++ b/perl/shiftc @@ -83,7 +83,7 @@ use constant SFTP_TRUNC => 0x10; use constant SFTP_WRITE => 0x02; use constant SFTP_EXCL => 0x20; -our $VERSION = 7.08; +our $VERSION = 8.0; $Data::Dumper::Indent = 0; $Data::Dumper::Purity = 1; @@ -233,7 +233,7 @@ if ($opts{h}) { if (scalar(@ARGV) > 0) { # ignore command if key generation forced and no arguments given my $cmd = shift @ARGV; - if ($cmd !~ /(?:^|\W)(?:bbcp|bbftp|bbscp|globus-url-copy|mesh-keykill|mesh-keytime|pcp\+|rm|rsync|scp|sftp|shiftc?|ssh|ssh-balance)$/ && $< != 0) { + if ($cmd !~ /(?:^|\W)(?:bbcp|bbftp|bbscp|mesh-keykill|mesh-keytime|pcp\+|rm|rsync|scp|sftp|shiftc?|ssh|ssh-balance)$/ && $< != 0) { # resolve all symlinks to support links to host:/path in VFS # (exclude rm so linked targets are not removed) # (exclude root to prevent unintended exposure/modification) @@ -245,7 +245,7 @@ if (scalar(@ARGV) > 0) { if ($cmd =~ /(?:^|\W)pwd$/) { print "$ENV{PWD}\n"; exit; - } elsif ($cmd !~ /(?:^|\W)(?:bbcp|bbftp|bbscp|globus-url-copy|mesh-keykill|mesh-keytime|pcp\+|rsync|scp|sftp|ssh|ssh-balance)$/ && + } elsif ($cmd !~ /(?:^|\W)(?:bbcp|bbftp|bbscp|mesh-keykill|mesh-keytime|pcp\+|rsync|scp|sftp|ssh|ssh-balance)$/ && !$argv_hostpath && (!hostpath($ENV{PWD}) || grep(!/^[-\/]/, @ARGV) == 0 || $cmd =~ /(?:^|\W)complete$/ && $ARGV[1] =~ /^\//)) { @@ -532,16 +532,6 @@ if ($ARGV[0] =~ /(?:^|\W)(?:scp|sftp)$/) { splice(@ARGV, 1, 0, ("-S", "$opts{ssh} %H bbcp", "-T", "$opts{ssh} %H bbcp")); } elsif ($ARGV[0] =~ /(?:^|\W)(?:bbftp|bbscp)$/) { splice(@ARGV, 1, 0, ("-L", $opts{ssh})); -} elsif ($ARGV[0] =~ /(?:^|\W)globus-url-copy$/) { - my $dir = glob("~/.globus"); - mkdir $dir if (! -d $dir); - my $file = "$dir/gridftp-ssh"; - open(FILE, '>', $file); - print FILE "#!/bin/sh\n$opts{ssh} \$2 sshftp"; - close FILE; - chmod(0700, $file); - # reduce $argc since no additional args are spliced onto @ARGV - $argc--; } elsif ($ARGV[0] =~ /(?:^|\W)pcp\+$/) { splice(@ARGV, 1, 0, ("-s", "$opts{ssh_l} $opts{p}")); } elsif ($ARGV[0] =~ /(?:^|\W)rsync$/) { @@ -1372,10 +1362,11 @@ sub shift_ { print " --mgr-user=USER access manager host as USER\n"; print " --monitor[=FORMAT] monitor progress of running transfers\n"; print " (FORMAT one of {color,csv,pad})\n"; - print " --plot[=[BY:]LIST] plot detailed performance when piped to gnuplot\n"; - print " (BY one of {client,host,id,user})\n"; - print " (LIST subset of {chattr,cksum,cp,find,io,ln,meta,\n"; - print " mkdir,sum})\n"; + print " --plot[=[BY[:/]]LIST] plot detailed performance when piped to gnuplot\n"; + print " (BY one of {client,fs,host,id,net,user})\n"; + print " (LIST subset of {bbftp,chattr,cksum,cp,find,fish,\n"; + print " fish-tcp,io,ln,mcp,meta,mkdir,msum,\n"; + print " rsync,shift-cp,shift-sum,sum,tool})\n"; print " --restart[=ignore] restart transfer with given --id [ignoring errors]\n"; print " --search=REGEX show only status/history matching REGEX\n"; print " --state=STATE show status of only those operations in STATE\n"; @@ -1395,12 +1386,10 @@ sub shift_ { print " (use suffix {k,m,b/g,t} for 1E{3,6,9,12}) [1k]\n"; print " --interval=NUM adjust batches to run for around NUM seconds [30]\n"; print " --local=LIST set local transport mechanism to one of LIST\n"; - print " (LIST subset of {bbcp,bbftp,fish,fish-tcp,gridftp,\n"; - print " mcp,rsync,shift})\n"; + print " (LIST subset of {bbftp,fish,fish-tcp,mcp,rsync,shift})\n"; print " --preallocate=NUM preallocate files when sparsity under NUM percent\n"; print " --remote=LIST set remote transport mechanism to one of LIST\n"; - print " (LIST subset of {bbcp,bbftp,fish,fish-tcp,gridftp,\n"; - print " rsync,shift})\n"; + print " (LIST subset of {bbftp,fish,fish-tcp,rsync,shift})\n"; print " --retry=NUM retry failed operations up to NUM times [2]\n"; print " --size=SIZE process transfer in batches of at least SIZE bytes\n"; print " (use suffix {k,m,g,t} for {KB,MB,GB,TB}) [4g]\n"; @@ -1569,10 +1558,22 @@ sub shift_ { } waitpid($pid, 0); =for mesh - # use agent key directly since agent will have been killed by child - $opts{sshmp} =~ s/^(ssh)/$1 -i $agent_key/; + # use new agent since initial agent will have been killed by child + $agent_sock = open3_get([-1, undef, -1], "ssh-agent -c"); + if ($agent_sock =~ /SSH_AGENT_PID\s+(\d+);/) { + $opts{k} = $1; + } + $agent_sock = $1 if ($agent_sock =~ /SSH_AUTH_SOCK\s+([^;]+);/); + $ENV{SSH_AUTH_SOCK} = $agent_sock; + open3_get([-1, undef], "ssh-add $agent_key"); =cut mesh my $out = shift_mgr("--status --state=none --id=$opts{id}"); +=for mesh + if ($opts{k}) { + # kill new agent + kill(SIGTERM, $opts{k}) && waitpid($opts{k}, 0); + } +=cut mesh if (defined $opts{monitor}) { print "\e[1A\e[K" foreach (1 .. 5); } @@ -2201,7 +2202,6 @@ sub shift_loop { next if ($t =~ /^(shift|fish(-tcp)?)$/); foreach my $path (split(/:/, $ENV{PATH})) { if (-x "$path/$t" || - $t eq 'gridftp' && -x "$path/globus-url-copy" || $t =~ /^fish(-tcp)$/ && -x "$path/$opts{caux}") { $have{$t} = 1; last; @@ -2230,7 +2230,7 @@ sub shift_loop { $rtthost->{$1} = 1; } elsif ($args[0] =~ /^(?:exclude|include)$/) { $opts{$args[0]} = thaw(unescape($op{text})); - } elsif ($args[0] =~ /^(?:bandwidth|buffer|create-tar|cron|dereference|extract-tar|find-files|force|get_host|ignore-times|index-tar|newer|offline|older|opts_bbcp|opts_bbftp|opts_gridftp|opts_mcp|opts_msum|opts_ssh|ports|preallocate|preserve|recall|sanity|secure|streams|stripe|stripe-pool|stripe-size|sum_split|sum_type|sync|sync_host|threads|window|verify|verify-fast)$/) { + } elsif ($args[0] =~ /^(?:bandwidth|buffer|create-tar|cron|dereference|extract-tar|find-files|force|get_host|ignore-times|index-tar|newer|offline|older|opts_bbftp|opts_mcp|opts_msum|opts_ssh|ports|preallocate|preserve|recall|sanity|secure|streams|stripe|stripe-pool|stripe-size|sum_split|sum_type|sync|sync_host|threads|window|verify|verify-fast)$/) { $opts{$args[0]} = defined $op{text} ? unescape($op{text}) : 1; } @@ -2549,7 +2549,7 @@ sub shift_mounts { $mnt{opts} = /[\(,]ro[\),]/ ? "ro" : "rw"; # acl support is the default unless explicitly disabled $mnt{opts} .= ",acl" if (/[\(,]acl[\),]/ || $acl && !/[\(,]noacl[\),]/); - $mnt{opts} .= ",dmf" if (/[\(,]dm(ap)?i[\),]/); + $mnt{opts} .= ",dmf" if (/[\(,](dmapi|dmi|xdsm)[\),]/); $mnt{opts} .= ",xattr" if (/[\(,]user_xattr[\),]/); #TODO: need to escape local and remote? (my $dev, $mnt{local}, my $type) = ($1, $2, $3) @@ -2590,18 +2590,32 @@ sub shift_mounts { # lustre may have extra @id and multiple colon-separated servers $mnt{servers} =~ s/@\w*//g; $mnt{servers} = join("|", map {$_ = fqdn($_)} split(/:/, $mnt{servers})); - } elsif ($type eq 'gpfs') { - # gpfs servers do not appear in mount output so call mmlsmgr - my $srv = open3_get([-1, undef, -1], "mmlsmgr $dev"); - # try a default location if not in path - $srv = open3_get([-1, undef, -1], - "/usr/lpp/mmfs/bin/mmlsmgr $dev") if (!$srv); + } elsif ($type eq 'beegfs') { + # beegfs servers do not appear in mount output so call beegfs-ctl + my $srv = open3_get([-1, undef, -1], + "beegfs-ctl --listnodes --nodetype=management --mount=$mnt{local}"); next if (!defined $srv); - # output is file system then server ip address - if ($srv =~ /^(\w+)\s+(\d+\.\d+\.\d+\.\d+)/m) { - $mnt{remote} = "/$1"; - $mnt{servers} = fqdn($2); + chomp $srv; + # output is host name then id + my @hosts; + push(@hosts, fqdn($1)) while ($srv =~ /^([\w-.]+)(\s|$)/mg); + next if (!scalar(@hosts)); + $mnt{servers} = join("|", @hosts); + $mnt{remote} = "/" . $mnt{servers}; + } elsif ($type eq 'gpfs') { + # gpfs servers do not appear in mount output so read config + if (open(FILE, "/var/mmfs/gen/mmfs.cfg")) { + while () { + s/^\s+|\s+$//g; + if (/^clustername\s+(\S+)/i) { + $mnt{servers} = $1; + $mnt{remote} = "/" . $mnt{servers}; + last; + } + } + close FILE; } + next if (!$mnt{servers}); } elsif ($mnt{opts} =~ /,dmf/) { # always report dmf file systems even if local $mnt{servers} = $mnt{host}; @@ -3254,16 +3268,10 @@ sub transport { my $tool = $opts{$type}->[ ($i + $ref->{try}) % scalar(@{$opts{$type}})]; next if ( - # bbcp does not encrypt and cannot handle partial transfers or - # (using --infiles) colon/ff/cr/lf/tab/vt in file names - $tool eq 'bbcp' && ($opts{secure} || $ref->{bytes} || - "$src$dst" =~ /[:\f\n\r\t\x0b]/) || # bbftp does not encrypt and cannot handle partial transfers or # whitespace/vt in file names $tool eq 'bbftp' && ($opts{secure} || $ref->{bytes} || "$src$dst" =~ /[\s\x0b]/) || - # gridftp cannot handle tar ops due to differing src/dst offsets - $tool eq 'gridftp' && defined $ref->{tar_bytes} || # rsync cannot handle partial transfers, and # (using --files-from) cannot handle cr/lf in file names $tool eq 'rsync' && ($ref->{bytes} || "$src$dst" =~ /[\n\r]/)); @@ -3298,16 +3306,12 @@ sub transport { foreach my $tool (keys %tools) { next if (!scalar(@{$tools{$tool}})); - if ($tool eq 'bbcp') { - transport_bbcp($host, $tools{$tool}); - } elsif ($tool eq 'bbftp') { + if ($tool eq 'bbftp') { transport_bbftp($host, $tools{$tool}); } elsif ($tool eq 'fish') { transport_fish($host, $tools{$tool}); } elsif ($tool eq 'fish-tcp') { transport_fish($host, $tools{$tool}, 1); - } elsif ($tool eq 'gridftp') { - transport_gridftp($host, $tools{$tool}); } elsif ($tool eq 'mcp') { transport_mcp($host, $tools{$tool}); } elsif ($tool eq 'rsync') { @@ -3330,139 +3334,6 @@ sub transport { return $rsize; } -######################## -#### transport_bbcp #### -######################## -sub transport_bbcp { - my ($host, $tcmds) = @_; - my %errs; - my ($fh, $tmp) = sftp_tmp(); - my $sep = chr(0); - my ($shost, $spath, $dhost, $dpath, $args); - if ($host eq 'localhost') { - $shost = ""; - # bbcp assumes host name instead of localhost when host not given - $dhost = "localhost:"; - $args = " -S bbcp -T bbcp"; - } else { - my $ssh_l; - if ($host =~ /@/) { - ($ssh_l, $host) = split(/@/, $host); - $ssh_l = " -l " . $ssh_l if ($ssh_l); - } - $args = " -S '$opts{ssh}$ssh_l %H bbcp' -T '$opts{ssh}$ssh_l %H bbcp'"; - } - - foreach my $cmd (@{$tcmds}) { - my ($op, $src, $dst, $ref) = @{$cmd}; - $ref->{tool} = "bbcp"; - if (!defined $shost) { - $shost = $op eq 'get' ? $host . ":" : ""; - $dhost = $op eq 'put' ? $host . ":" : ""; - } - - # find longest common suffix starting with "/" - if ("$src$sep$dst" =~ /^.*?(\/.*)$sep.*\1$/) { - my $lcs = $1; - # bbcp batch mode does not use leading slashes like rsync - $lcs =~ s/^\/+//; - if ($spath && $src eq "$spath/$lcs" && $dst eq "$dpath/$lcs") { - print $fh ($shost ? $shost . ":" : ""), "$lcs\n"; - $errs{"$spath/$lcs"}->{$ref} = $ref; - $errs{"$dpath/$lcs"}->{$ref} = $ref; - next; - } elsif ($spath) { - # next file has different prefix so process current batch - close $fh; - transport_bbcp_batch($args . ($shost ? " -z" : ""), $tmp, - "$shost$spath", "$dhost$dpath", \%errs, $host); - %errs = (); - open($fh, '>', $tmp); - } - print $fh ($shost ? $shost . ":" : ""), "$lcs\n"; - $spath = $src; - # escape lcs in case it contains regex characters - $spath =~ s/\/\Q$lcs\E$//; - $dpath = $dst; - $dpath =~ s/\/\Q$lcs\E$//; - $errs{"$spath/$lcs"}->{$ref} = $ref; - $errs{"$dpath/$lcs"}->{$ref} = $ref; - } else { - # no common suffix implies single file copy with rename - # or symlink dereference - my %errs_tmp; - # use different hash as other files may already be in there - $errs_tmp{$src}->{$ref} = $ref; - $errs_tmp{$dst}->{$ref} = $ref; - transport_bbcp_batch($args . ($shost ? " -z" : ""), "", - "$shost$src", "$dhost$dst", \%errs_tmp, $host); - } - } - - close $fh; - if ($spath) { - transport_bbcp_batch($args . ($shost ? " -z" : ""), $tmp, - "$shost$spath", "$dhost$dpath", \%errs, $host); - } - unlink $tmp; -} - -############################## -#### transport_bbcp_batch #### -############################## -sub transport_bbcp_batch { - my ($args, $from, $src, $dst, $errs, $host) = @_; - my ($pid, $in, $out, $size); - $from = " --infiles $from -d" if ($from); - eval { - local $SIG{__WARN__} = sub {die}; - # escape remote src/dst metacharacters since interpreted by remote shell - my ($esrc, $edst) = ($src, $dst); - $esrc =~ s/([^A-Za-z0-9\-_.:+\/])/\\$1/g if ($esrc =~ /^[^\/]/); - $edst =~ s/([^A-Za-z0-9\-_.:+\/])/\\$1/g if ($edst =~ /^[^\/]/); - my $nstream = $host eq 'localhost' ? $opts{threads} : $opts{streams}; - my $extra; - $extra .= " -B " . $opts{buffer} if ($opts{buffer}); - $extra .= " -s " . $nstream if ($nstream); - $extra .= " -w " . $opts{window} if ($opts{window}); - $extra .= " -Z " . $opts{ports} if ($opts{ports}); - # apply opts_bbcp last to override other settings - $extra .= " " . $opts{opts_bbcp}; - # use open3 to avoid executing a shell command based on the name - # of a file being copied (which may contain metacharacters, etc.) - # must keep write access to handle warnings/corruption - $pid = IPC::Open3::open3($in, $out, $out, - # make sure quotewords string does not end in space - quotewords('\s+', 0, "bbcp $extra -AfKv -m 0600$args$from"), - $esrc, $edst); - }; - if (!$@) { - while (my $line = <$out>) { - $line =~ s/\s+$//; - if ($line =~ /^File (.*) created(?!.*created)/) { - my $file = $1; - foreach my $key (grep(/^\Q$file\E$/, keys(%{$errs}))) { - $_->{text} = 0 foreach (values %{$errs->{$key}}); - } - } elsif ($line =~ /^bbcp: [^\/]*(\/.*)/) { - my $file = $1; - foreach my $key (grep(/^\Q$file\E$/, keys(%{$errs}))) { - sftp_error($_, $line) foreach (values %{$errs->{$key}}); - } - } - } - } - close $in; - close $out; - waitpid($pid, 0) if ($pid); - - foreach my $key (keys %{$errs}) { - foreach (values %{$errs->{$key}}) { - sftp_error($_, "unknown bbcp failure") if (!defined $_->{text}); - } - } -} - ######################### #### transport_bbftp #### ######################### @@ -3564,7 +3435,8 @@ sub transport_chattr { foreach my $cmd (@{$tcmds}) { my ($op, $src, $dst, $ref) = @{$cmd}; # lfs setstripe (must be done before fallocate) - if ((!$opts{'create-tar'} && $op =~ /^(?:get|mkdir|put)$/ || + if ((!$opts{'create-tar'} && ($op =~ /^(?:get|put)$/ || + $op eq 'mkdir' && $ref->{lustre_attrs}) || $op eq 'chattr' && $ref->{tar_creat}) && $ref->{dstfs} && $ref->{dstfs} =~ /^lustre/ && !$ref->{ln} && ($opts{stripe} ne '0' || defined $opts{'stripe-size'} || @@ -3573,23 +3445,28 @@ sub transport_chattr { my @stripe = (0, 0); # preserve existing striping when available @stripe = split(/,/, $ref->{lustre_attrs}) if ($ref->{lustre_attrs}); - my @attrs = split(/,/, $ref->{attrs}); - # define variables that are allowed in striping expressions - my ($nm, $sz, $sc, $ss) = ($dst, $attrs[7], @stripe); - # base striping on tar size instead of file size during tar creation - $sz = $ref->{tar_creat} if ($ref->{tar_creat}); - my @evals = ($opts{stripe}, $opts{'stripe-size'}); - push(@evals, $opts{'stripe-pool'}) - if ($opts{'stripe-pool'} !~ /^[\w.-]+$/); - # evaluate all striping expressions - foreach my $i (0 .. 2) { - my $eval = $evals[$i]; - next if (!$eval); - $eval =~ s/(NM|SZ|SC|SS)/q($).lc($1)/eg; - $stripe[$i] = eval $eval; + # preserve but do not apply striping expressions to directories + if ($op ne 'mkdir') { + my @attrs = split(/,/, $ref->{attrs}); + # define variables that are allowed in striping expressions + my ($nm, $sz, $sc, $ss) = ($dst, $attrs[7], @stripe); + # base striping on tar size instead of file size during tar creation + $sz = $ref->{tar_creat} if ($ref->{tar_creat}); + my @evals = ($opts{stripe}, $opts{'stripe-size'}); + push(@evals, $opts{'stripe-pool'}) + if ($opts{'stripe-pool'} !~ /^[\w.-]+$/); + # evaluate all striping expressions + foreach my $i (0 .. 2) { + my $eval = $evals[$i]; + next if (!$eval); + $eval =~ s/(NM|SZ|SC|SS)/q($).lc($1)/eg; + $stripe[$i] = eval $eval; + } + # count >= 64k indicates a size per stripe + $stripe[0] = ceil($sz / $stripe[0]) if ($stripe[0] >= 65536); } - # count >= 64k indicates a size per stripe - $stripe[0] = ceil($sz / $stripe[0]) if ($stripe[0] >= 65536); + # size should never be < 64k (llapi inexplicably returns 2 for dirs) + $stripe[1] = 0 if ($stripe[1] < 65536); my @args = ("setstripe", escape($dst) . ($op eq 'mkdir' ? "/" : ""), join(" ", @stripe)); push(@chattrs, \@args); @@ -4722,116 +4599,6 @@ sub transport_fish_return { return {error => "Invalid protocol return ($msg)"}; } -########################### -#### transport_gridftp #### -########################### -sub transport_gridftp { - my ($host, $tcmds) = @_; - my $ssh_l; - if ($host =~ /@/) { - ($ssh_l, $host) = split(/@/, $host); - $ssh_l = " -l " . $ssh_l if ($ssh_l); - } - # make sure gridftp-ssh is set up properly - my $prefix = $host ne 'localhost' ? "sshftp://$host" : "file://"; - my $dir = glob("~/.globus"); - mkdir $dir if (! -d $dir); - my $file = "$dir/gridftp-ssh"; - open(FILE, '>', $file); - # note that sshftp must exist in path (normally resides in .globus/sshftp) - print FILE "#!/bin/sh\n$opts{ssh}$ssh_l \$2 sshftp"; - close FILE; - chmod(0700, $file); - - my %errs; - my ($fh, $tmp); - foreach my $cmd (@{$tcmds}) { - my ($op, $src, $dst, $ref) = @{$cmd}; - ($fh, $tmp) = sftp_tmp() if (!$tmp); - if ($op eq 'put') { - $src = "file://" . escape($src); - $dst = $prefix . escape($dst); - $errs{"$src $dst"} = $ref; - } else { - $src = $prefix . escape($src); - $dst = "file://" . escape($dst); - $errs{"$src $dst"} = $ref; - } - if ($ref->{bytes}) { - my @ranges = split(/,/, $ref->{bytes}); - foreach my $range (@ranges) { - my ($x1, $x2) = split(/-/, $range); - print $fh "$src $dst $x1,", $x2 - $x1, "\n"; - } - } else { - print $fh "$src $dst\n"; - } - $ref->{tool} = "gridftp"; - } - return if (!$tmp); - close $fh; - - my $nstream = $host eq 'localhost' ? $opts{threads} : $opts{streams}; - my $extra; - $extra .= " -bs " . $opts{buffer} if ($opts{buffer}); - $extra .= " -p " . $nstream if ($nstream); - $extra .= " -tcp-bs " . $opts{window} if ($opts{window}); - # encrypt data channel during secure transfers - $extra .= " -dcpriv" if ($opts{secure}); - # apply opts_gridftp last to override other settings - $extra .= " " . $opts{opts_gridftp}; - if ($opts{ports}) { - #TODO: test that this really works (both on open3 side and globus side) - my $ports = $opts{ports}; - $ports =~ s/:/,/; - $ENV{GLOBUS_TCP_RANGE} = $ports; - $ENV{GLOBUS_TCP_PORT_RANGE} = $ports; - $ENV{GLOBUS_TCP_SOURCE_RANGE} = $ports; - $ENV{GLOBUS_UDP_PORT_RANGE} = $ports; - $ENV{GLOBUS_UDP_SOURCE_RANGE} = $ports; - } - if (open(OUT, '-|', - # unbuffer must be used to interleave stdout/stderr - "unbuffer globus-url-copy $extra -c -cd -r -v -f $tmp 2>&1")) { - my ($src, $dst, $text); - while (my $line = ) { - $line =~ s/\s+$//; - if ($line =~ /^Source:\s*(\S+)/) { - if ($dst && $text && $errs{"$src $dst"}) { - sftp_error($errs{"$src $dst"}, $text); - } elsif ($dst && $errs{"$src $dst"}) { - $errs{"$src $dst"}->{text} = 0; - } - $text = undef; - $src = $1; - } elsif ($line =~ /^Dest:\s*(\S+)/) { - $dst = $1; - } elsif ($line =~ /^\s*(\S+)\s*->\s*(\S+)$/) { - $src .= $1; - $dst .= $2; - } elsif ($line =~ /^\s*(\S+)$/) { - $src .= $1; - $dst .= $1; - } elsif ($line && $line !~ /^error: There was an error with/) { - $text .= $line . " "; - } - } - if ($dst && $text && $errs{"$src $dst"}) { - sftp_error($errs{"$src $dst"}, $text); - } elsif ($dst && $errs{"$src $dst"}) { - $errs{"$src $dst"}->{text} = 0; - } - } - close OUT; - - foreach my $key (keys %errs) { - if (!defined $errs{$key}->{text}) { - sftp_error($errs{$key}, "unknown gridftp failure"); - } - } - unlink $tmp; -} - ####################### #### transport_mcp #### ####################### @@ -5167,6 +4934,8 @@ sub transport_shift { push(@scmds, [$x == $x1 ? undef : $x . "-" . $x2, $cmd]); } } + # return when no work (mainly when single-threaded) + return if (!scalar(@scmds)); foreach my $o (keys %opts) { # must kill existing sftp connections or various things can hang