+#
+# For printing exec commands (which don't use a shell) so they look like
+# a valid shell command this function should be called with the exec
+# args. The shell command string is returned.
+#
+sub execCmd2ShellCmd
+{
+ my($bpc, @args) = @_;
+ my $str;
+
+ foreach my $a ( @args ) {
+ $str .= " " if ( $str ne "" );
+ $str .= $bpc->shellEscape($a);
+ }
+ return $str;
+}
+
+#
+# Do a URI-style escape to protect/encode special characters
+#
+sub uriEsc
+{
+ my($bpc, $s) = @_;
+ $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
+ return $s;
+}
+
+#
+# Do a URI-style unescape to restore special characters
+#
+sub uriUnesc
+{
+ my($bpc, $s) = @_;
+ $s =~ s{%(..)}{chr(hex($1))}eg;
+ return $s;
+}
+
+#
+# Do variable substitution prior to execution of a command.
+#
+sub cmdVarSubstitute
+{
+ my($bpc, $template, $vars) = @_;
+ my(@cmd);
+
+ #
+ # Return without any substitution if the first entry starts with "&",
+ # indicating this is perl code.
+ #
+ if ( (ref($template) eq "ARRAY" ? $template->[0] : $template) =~ /^\&/ ) {
+ return $template;
+ }
+ if ( ref($template) ne "ARRAY" ) {
+ #
+ # Split at white space, except if escaped by \
+ #
+ $template = [split(/(?<!\\)\s+/, $template)];
+ #
+ # Remove the \ that escaped white space.
+ #
+ foreach ( @$template ) {
+ s{\\(\s)}{$1}g;
+ }
+ }
+ #
+ # Merge variables into @cmd
+ #
+ foreach my $arg ( @$template ) {
+ #
+ # Replace $VAR with ${VAR} so that both types of variable
+ # substitution are supported
+ #
+ $arg =~ s[\$(\w+)]{\${$1}}g;
+ #
+ # Replace scalar variables first
+ #
+ $arg =~ s[\${(\w+)}(\+?)]{
+ exists($vars->{$1}) && ref($vars->{$1}) ne "ARRAY"
+ ? ($2 eq "+" ? $bpc->shellEscape($vars->{$1}) : $vars->{$1})
+ : "\${$1}$2"
+ }eg;
+ #
+ # Now replicate any array arguments; this just works for just one
+ # array var in each argument.
+ #
+ if ( $arg =~ m[(.*)\${(\w+)}(\+?)(.*)] && ref($vars->{$2}) eq "ARRAY" ) {
+ my $pre = $1;
+ my $var = $2;
+ my $esc = $3;
+ my $post = $4;
+ foreach my $v ( @{$vars->{$var}} ) {
+ $v = $bpc->shellEscape($v) if ( $esc eq "+" );
+ push(@cmd, "$pre$v$post");
+ }
+ } else {
+ push(@cmd, $arg);
+ }
+ }
+ return \@cmd;
+}
+
+#
+# Exec or eval a command. $cmd is either a string on an array ref.
+#
+# @args are optional arguments for the eval() case; they are not used
+# for exec().
+#
+sub cmdExecOrEval
+{
+ my($bpc, $cmd, @args) = @_;
+
+ if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
+ $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
+ print(STDERR "cmdExecOrEval: about to eval perl code $cmd\n")
+ if ( $bpc->{verbose} );
+ eval($cmd);
+ print(STDERR "Perl code fragment for exec shouldn't return!!\n");
+ exit(1);
+ } else {
+ $cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
+ print(STDERR "cmdExecOrEval: about to exec ",
+ $bpc->execCmd2ShellCmd(@$cmd), "\n")
+ if ( $bpc->{verbose} );
+ alarm(0);
+ $cmd = [map { m/(.*)/ } @$cmd]; # untaint
+ #
+ # force list-form of exec(), ie: no shell even for 1 arg
+ #
+ exec { $cmd->[0] } @$cmd;
+ print(STDERR "Exec failed for @$cmd\n");
+ exit(1);
+ }
+}
+
+#
+# System or eval a command. $cmd is either a string on an array ref.
+# $stdoutCB is a callback for output generated by the command. If it
+# is undef then output is returned. If it is a code ref then the function
+# is called with each piece of output as an argument. If it is a scalar
+# ref the output is appended to this variable.
+#
+# @args are optional arguments for the eval() case; they are not used
+# for system().
+#
+# Also, $? should be set when the CHILD pipe is closed.
+#
+sub cmdSystemOrEvalLong
+{
+ my($bpc, $cmd, $stdoutCB, $ignoreStderr, $pidHandlerCB, @args) = @_;
+ my($pid, $out, $allOut);
+ local(*CHILD);
+
+ $? = 0;
+ if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
+ $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
+ print(STDERR "cmdSystemOrEval: about to eval perl code $cmd\n")
+ if ( $bpc->{verbose} );
+ $out = eval($cmd);
+ $$stdoutCB .= $out if ( ref($stdoutCB) eq 'SCALAR' );
+ &$stdoutCB($out) if ( ref($stdoutCB) eq 'CODE' );
+ print(STDERR "cmdSystemOrEval: finished: got output $out\n")
+ if ( $bpc->{verbose} );
+ return $out if ( !defined($stdoutCB) );
+ return;
+ } else {
+ $cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
+ print(STDERR "cmdSystemOrEval: about to system ",
+ $bpc->execCmd2ShellCmd(@$cmd), "\n")
+ if ( $bpc->{verbose} );
+ if ( !defined($pid = open(CHILD, "-|")) ) {
+ my $err = "Can't fork to run @$cmd\n";
+ $? = 1;
+ $$stdoutCB .= $err if ( ref($stdoutCB) eq 'SCALAR' );
+ &$stdoutCB($err) if ( ref($stdoutCB) eq 'CODE' );
+ return $err if ( !defined($stdoutCB) );
+ return;
+ }
+ binmode(CHILD);
+ if ( !$pid ) {
+ #
+ # This is the child
+ #
+ close(STDERR);
+ if ( $ignoreStderr ) {
+ open(STDERR, ">", "/dev/null");
+ } else {
+ open(STDERR, ">&STDOUT");
+ }
+ alarm(0);
+ $cmd = [map { m/(.*)/ } @$cmd]; # untaint
+ #
+ # force list-form of exec(), ie: no shell even for 1 arg
+ #
+ exec { $cmd->[0] } @$cmd;
+ print(STDERR "Exec of @$cmd failed\n");
+ exit(1);
+ }
+
+ #
+ # Notify caller of child's pid
+ #
+ &$pidHandlerCB($pid) if ( ref($pidHandlerCB) eq "CODE" );
+
+ #
+ # The parent gathers the output from the child
+ #
+ while ( <CHILD> ) {
+ $$stdoutCB .= $_ if ( ref($stdoutCB) eq 'SCALAR' );
+ &$stdoutCB($_) if ( ref($stdoutCB) eq 'CODE' );
+ $out .= $_ if ( !defined($stdoutCB) );
+ $allOut .= $_ if ( $bpc->{verbose} );
+ }
+ $? = 0;
+ close(CHILD);
+ }
+ print(STDERR "cmdSystemOrEval: finished: got output $allOut\n")
+ if ( $bpc->{verbose} );
+ return $out;
+}
+
+#
+# The shorter version that sets $ignoreStderr = 0, ie: merges stdout
+# and stderr together.
+#
+sub cmdSystemOrEval
+{
+ my($bpc, $cmd, $stdoutCB, @args) = @_;
+
+ return $bpc->cmdSystemOrEvalLong($cmd, $stdoutCB, 0, undef, @args);
+}
+
+#
+# Promotes $conf->{BackupFilesOnly}, $conf->{BackupFilesExclude}
+# to hashes and $conf->{$shareName} to an array.
+#
+sub backupFileConfFix
+{
+ my($bpc, $conf, $shareName) = @_;
+
+ $conf->{$shareName} = [ $conf->{$shareName} ]
+ if ( ref($conf->{$shareName}) ne "ARRAY" );
+ foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
+ next if ( !defined($conf->{$param}) );
+ if ( ref($conf->{$param}) eq "HASH" ) {
+ #
+ # A "*" entry means wildcard - it is the default for
+ # all shares. Replicate the "*" entry for all shares,
+ # but still allow override of specific entries.
+ #
+ next if ( !defined($conf->{$param}{"*"}) );
+ $conf->{$param} = {
+ map({ $_ => $conf->{$param}{"*"} }
+ @{$conf->{$shareName}}),
+ %{$conf->{$param}}
+ };
+ } else {
+ $conf->{$param} = [ $conf->{$param} ]
+ if ( ref($conf->{$param}) ne "ARRAY" );
+ $conf->{$param} = { map { $_ => $conf->{$param} }
+ @{$conf->{$shareName}} };
+ }
+ }
+}
+
+#
+# This is sort() compare function, used below.
+#
+# New client LOG names are LOG.MMYYYY. Old style names are
+# LOG, LOG.0, LOG.1 etc. Sort them so new names are
+# first, and newest to oldest.
+#
+sub compareLOGName
+{
+ my $na = $1 if ( $a =~ /LOG\.(\d+)(\.z)?$/ );
+ my $nb = $1 if ( $b =~ /LOG\.(\d+)(\.z)?$/ );
+
+ $na = -1 if ( !defined($na) );
+ $nb = -1 if ( !defined($nb) );
+
+ if ( length($na) >= 5 && length($nb) >= 5 ) {
+ #
+ # Both new style: format is MMYYYY. Bigger dates are
+ # more recent.
+ #
+ my $ma = $2 * 12 + $1 if ( $na =~ /(\d+)(\d{4})/ );
+ my $mb = $2 * 12 + $1 if ( $nb =~ /(\d+)(\d{4})/ );
+ return $mb - $ma;
+ } elsif ( length($na) >= 5 && length($nb) < 5 ) {
+ return -1;
+ } elsif ( length($na) < 5 && length($nb) >= 5 ) {
+ return 1;
+ } else {
+ #
+ # Both old style. Smaller numbers are more recent.
+ #
+ return $na - $nb;
+ }
+}
+
+#
+# Returns list of paths to a clients's (or main) LOG files,
+# most recent first.
+#
+sub sortedPCLogFiles
+{
+ my($bpc, $host) = @_;
+
+ my(@files, $dir);
+
+ if ( $host ne "" ) {
+ $dir = "$bpc->{TopDir}/pc/$host";
+ } else {
+ $dir = "$bpc->{LogDir}";
+ }
+ if ( opendir(DIR, $dir) ) {
+ foreach my $file ( readdir(DIR) ) {
+ next if ( !-f "$dir/$file" );
+ next if ( $file ne "LOG" && $file !~ /^LOG\.\d/ );
+ push(@files, "$dir/$file");
+ }
+ closedir(DIR);
+ }
+ return sort compareLOGName @files;
+}
+
+#
+# converts a glob-style pattern into a perl regular expression.
+#
+sub glob2re
+{
+ my ( $bpc, $glob ) = @_;
+ my ( $char, $subst );
+
+ # $escapeChars escapes characters with no special glob meaning but
+ # have meaning in regexps.
+ my $escapeChars = [ '.', '/', ];
+
+ # $charMap is where we implement the special meaning of glob
+ # patterns and translate them to regexps.
+ my $charMap = {
+ '?' => '[^/]',
+ '*' => '[^/]*', };
+
+ # multiple forward slashes are equivalent to one slash. We should
+ # never have to use this.
+ $glob =~ s/\/+/\//;
+
+ foreach $char (@$escapeChars) {
+ $glob =~ s/\Q$char\E/\\$char/g;
+ }
+
+ while ( ( $char, $subst ) = each(%$charMap) ) {
+ $glob =~ s/(?<!\\)\Q$char\E/$subst/g;
+ }
+
+ return $glob;
+}
+