+#copy symbols in running_as_flags to constants
+push @{$EXPORT_TAGS{"constants"}}, @{$EXPORT_TAGS{"running_as_flags"}};
+
+push @EXPORT_OK, qw(pcontext_t_to_string);
+push @{$EXPORT_TAGS{"pcontext_t"}}, qw(pcontext_t_to_string);
+
+my %_pcontext_t_VALUES;
+#Convert an enum value to a single string
+sub pcontext_t_to_string {
+ my ($enumval) = @_;
+
+ for my $k (keys %_pcontext_t_VALUES) {
+ my $v = $_pcontext_t_VALUES{$k};
+
+ #is this a matching flag?
+ if ($enumval == $v) {
+ return $k;
+ }
+ }
+
+#default, just return the number
+ return $enumval;
+}
+
+push @EXPORT_OK, qw($CONTEXT_DEFAULT);
+push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_DEFAULT);
+
+$_pcontext_t_VALUES{"CONTEXT_DEFAULT"} = $CONTEXT_DEFAULT;
+
+push @EXPORT_OK, qw($CONTEXT_CMDLINE);
+push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_CMDLINE);
+
+$_pcontext_t_VALUES{"CONTEXT_CMDLINE"} = $CONTEXT_CMDLINE;
+
+push @EXPORT_OK, qw($CONTEXT_DAEMON);
+push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_DAEMON);
+
+$_pcontext_t_VALUES{"CONTEXT_DAEMON"} = $CONTEXT_DAEMON;
+
+push @EXPORT_OK, qw($CONTEXT_SCRIPTUTIL);
+push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_SCRIPTUTIL);
+
+$_pcontext_t_VALUES{"CONTEXT_SCRIPTUTIL"} = $CONTEXT_SCRIPTUTIL;
+
+#copy symbols in pcontext_t to constants
+push @{$EXPORT_TAGS{"constants"}}, @{$EXPORT_TAGS{"pcontext_t"}};
+
+sub full_read {
+ my ($fd, $count) = @_;
+ my @bufs;
+
+ while ($count > 0) {
+ my $b;
+ my $n_read = POSIX::read($fd, $b, $count);
+ if (!defined $n_read) {
+ next if ($! == EINTR);
+ return undef;
+ } elsif ($n_read == 0) {
+ last;
+ }
+ push @bufs, $b;
+ $count -= $n_read;
+ }
+
+ return join('', @bufs);
+}
+
+sub full_write {
+ my ($fd, $buf, $count) = @_;
+ my $total = 0;
+
+ while ($count > 0) {
+ my $n_written = POSIX::write($fd, $buf, $count);
+ if (!defined $n_written) {
+ next if ($! == EINTR);
+ return undef;
+ } elsif ($n_written == 0) {
+ last;
+ }
+
+ $count -= $n_written;
+ $total += $n_written;
+
+ if ($count) {
+ $buf = substr($buf, $n_written);
+ }
+ }
+
+ return $total;
+}
+
+sub skip_quoted_string {
+ my $str = shift;
+
+ chomp $str;
+ my $iq = 0;
+ my $i = 0;
+ my $c = substr $str, $i, 1;
+ while ($c ne "" && !($iq == 0 && $c =~ /\s/)) {
+ if ($c eq '"') {
+ $iq = !$iq;
+ } elsif ($c eq '\\') {
+ $i++;
+ }
+ $i++;
+ $c = substr $str, $i, 1;
+ }
+ my $quoted_string = substr $str, 0, $i;
+ my $remainder = undef;
+ if (length($str) > $i) {
+ $remainder = substr $str, $i+1;
+ }
+
+ return ($quoted_string, $remainder);
+}
+
+sub split_quoted_string_friendly {
+ my $str = shift;
+ my @result;
+
+ chomp $str;
+ $str =~ s/^\s+//;
+ while ($str) {
+ (my $elt, $str) = skip_quoted_string($str);
+ push @result, unquote_string($elt);
+ $str =~ s/^\s+// if $str;
+ }
+
+ return @result;
+}
+
+
+push @EXPORT_OK, qw(slurp);
+
+push @EXPORT_OK, qw(burp);
+
+push @EXPORT_OK, qw(safe_overwrite_file);
+
+
+sub slurp {
+ my $file = shift @_;
+ local $/;
+
+ open my $fh, "<", $file or croak "can't open $file: $!";
+ my $data = <$fh>;
+ close $fh;
+
+ return $data;
+}
+
+sub burp {
+ my $file = shift @_;
+ open my $fh, ">", $file or croak "can't open $file: $!";
+ print $fh @_;
+}
+
+sub safe_overwrite_file {
+ my ( $filename, $contents ) = @_;
+
+ my $tmpfname = "$filename." . time;
+ open my $tmpfh, ">", $tmpfname or die "open: $!";
+
+ print $tmpfh $contents;
+ (fsync($tmpfh) == 0) or die "fsync: $!";
+ return rename $tmpfname, $filename;
+}
+
+
+push @EXPORT_OK, qw(hexencode hexdecode);
+push @{$EXPORT_TAGS{"encoding"}}, qw(hexencode hexdecode);
+
+push @EXPORT_OK, qw(quote_string unquote_string skip_quoted_string
+ sanitise_filename split_quoted_strings split_quoted_strings_friendly);
+push @{$EXPORT_TAGS{"quoting"}}, qw(quote_string unquote_string skip_quoted_string
+ sanitise_filename split_quoted_strings split_quoted_strings_friendly);
+
+push @EXPORT_OK, qw(expand_braced_alternates collapse_braced_alternates);
+push @{$EXPORT_TAGS{"alternates"}}, qw(expand_braced_alternates collapse_braced_alternates);
+
+
+sub generate_timestamp {
+ # this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
+ if (getconf($CNF_USETIMESTAMPS)) {
+ return strftime "%Y%m%d%H%M%S", localtime;
+ } else {
+ return strftime "%Y%m%d", localtime;
+ }
+}
+
+sub built_with_component {
+ my ($component) = @_;
+ my @components = split / +/, $Amanda::Constants::AMANDA_COMPONENTS;
+ return grep { $_ eq $component } @components;
+}
+
+
+
+sub is_pid_alive {
+ my ($pid) = shift;
+
+ return 1 if $pid == $$;
+
+ my $Amanda_process = Amanda::Process->new(0);
+
+ $Amanda_process->load_ps_table();
+ my $alive = $Amanda_process->process_alive($pid);
+ return $alive;
+
+}
+
+push @EXPORT_OK, qw(weaken_ref);
+
+push @EXPORT_OK, qw(stream_server stream_accept check_security);
+
+push @EXPORT_OK, qw($AF_INET $STREAM_BUFSIZE);
+push @{$EXPORT_TAGS{"constants"}}, qw($AF_INET $STREAM_BUFSIZE);
+
+
+# these functions were verified to work similarly to those in
+# common-src/tapelist.c - they pass the same tests, at least.
+
+sub marshal_tapespec {
+ my ($filelist) = @_;
+ my @filelist = @$filelist; # make a copy we can wreck
+ my @specs;
+
+ while (@filelist) {
+ my $label = shift @filelist;
+ my $files = shift @filelist;
+
+ $label =~ s/([\\:;,])/\\$1/g;
+ push @specs, "$label:" . join(",", @$files);
+ }
+ return join(";", @specs);
+}
+
+sub unmarshal_tapespec {
+ my ($tapespec) = @_;
+ my @filelist;
+
+ # detect a non-tapespec string for special handling; in particular, a string
+ # without an unquoted : followed by digits and commas at the end. The easiest
+ # way to do this is to replace every quoted character with a dummy, then look
+ # for the colon and digits.
+ my $tmp = $tapespec;
+ $tmp =~ s/\\([\\:;,])/X/g;
+ if ($tmp !~ /:[,\d]+$/) {
+ # ok, it doesn't end with the right form, so unquote it and return it
+ # with filenum 0
+ $tapespec =~ s/\\([\\:;,])/$1/g;
+ return [ $tapespec, [ 0 ] ];
+ }
+
+ # use a lookbehind to mask out any quoted ;'s
+ my @volumes = split(/(?<!\\);/, $tapespec);
+ for my $vol (@volumes) {
+ my ($label, $files) = ($vol =~ /(.+):([\d,]+)/);
+
+ $label =~ s/\\([\\:;,])/$1/g;
+ push @filelist, $label;
+
+ my @files = split(/,/, $files);
+ @files = map { $_+0 } @files;
+ @files = sort { $a <=> $b } @files;
+ push @filelist, \@files;
+ }
+
+ return \@filelist;
+}
+
+