# This file was automatically generated by SWIG (http://www.swig.org).
-# Version 1.3.33
+# Version 1.3.39
#
-# Don't modify this file, modify the SWIG interface instead.
+# Do not make changes to this file unless you know what you are doing--modify
+# the SWIG interface file instead.
package Amanda::Util;
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use base qw(Exporter);
+use base qw(DynaLoader);
package Amanda::Utilc;
bootstrap Amanda::Util;
package Amanda::Util;
-@EXPORT = qw( );
+@EXPORT = qw();
# ---------- BASE METHODS -------------
package Amanda::Util;
+*get_original_cwd = *Amanda::Utilc::get_original_cwd;
+*hexencode = *Amanda::Utilc::hexencode;
+*hexdecode = *Amanda::Utilc::hexdecode;
+*sanitise_filename = *Amanda::Utilc::sanitise_filename;
+*quote_string = *Amanda::Utilc::quote_string;
+*unquote_string = *Amanda::Utilc::unquote_string;
+*expand_braced_alternates = *Amanda::Utilc::expand_braced_alternates;
+*collapse_braced_alternates = *Amanda::Utilc::collapse_braced_alternates;
+*split_quoted_strings = *Amanda::Utilc::split_quoted_strings;
+*get_fs_usage = *Amanda::Utilc::get_fs_usage;
+*fsync = *Amanda::Utilc::fsync;
+*set_blocking = *Amanda::Utilc::set_blocking;
+*weaken_ref = *Amanda::Utilc::weaken_ref;
+*gettimeofday = *Amanda::Utilc::gettimeofday;
+*openbsd_fd_inform = *Amanda::Utilc::openbsd_fd_inform;
+*stream_server = *Amanda::Utilc::stream_server;
+*stream_accept = *Amanda::Utilc::stream_accept;
+*check_security = *Amanda::Utilc::check_security;
*set_pname = *Amanda::Utilc::set_pname;
+*get_pname = *Amanda::Utilc::get_pname;
+*set_ptype = *Amanda::Utilc::set_ptype;
+*get_ptype = *Amanda::Utilc::get_ptype;
+*set_pcontext = *Amanda::Utilc::set_pcontext;
+*get_pcontext = *Amanda::Utilc::get_pcontext;
*safe_cd = *Amanda::Utilc::safe_cd;
*check_running_as = *Amanda::Utilc::check_running_as;
-*set_erroutput_type = *Amanda::Utilc::set_erroutput_type;
+
+############# Class : Amanda::Util::file_lock ##############
+
+package Amanda::Util::file_lock;
+use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
+@ISA = qw( Amanda::Util );
+%OWNER = ();
+%ITERATORS = ();
+sub new {
+ my $pkg = shift;
+ my $self = Amanda::Utilc::new_file_lock(@_);
+ bless $self, $pkg if defined($self);
+}
+
+*lock = *Amanda::Utilc::file_lock_lock;
+*unlock = *Amanda::Utilc::file_lock_unlock;
+*write = *Amanda::Utilc::file_lock_write;
+*data = *Amanda::Utilc::file_lock_data;
+sub DESTROY {
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ return unless defined $self;
+ delete $ITERATORS{$self};
+ if (exists $OWNER{$self}) {
+ Amanda::Utilc::delete_file_lock($self);
+ delete $OWNER{$self};
+ }
+}
+
+sub DISOWN {
+ my $self = shift;
+ my $ptr = tied(%$self);
+ delete $OWNER{$ptr};
+}
+
+sub ACQUIRE {
+ my $self = shift;
+ my $ptr = tied(%$self);
+ $OWNER{$ptr} = 1;
+}
+
# ------- VARIABLE STUBS --------
package Amanda::Util;
+*RUNNING_AS_ANY = *Amanda::Utilc::RUNNING_AS_ANY;
*RUNNING_AS_ROOT = *Amanda::Utilc::RUNNING_AS_ROOT;
*RUNNING_AS_DUMPUSER = *Amanda::Utilc::RUNNING_AS_DUMPUSER;
*RUNNING_AS_DUMPUSER_PREFERRED = *Amanda::Utilc::RUNNING_AS_DUMPUSER_PREFERRED;
*RUNNING_AS_CLIENT_LOGIN = *Amanda::Utilc::RUNNING_AS_CLIENT_LOGIN;
*RUNNING_AS_UID_ONLY = *Amanda::Utilc::RUNNING_AS_UID_ONLY;
+*CONTEXT_DEFAULT = *Amanda::Utilc::CONTEXT_DEFAULT;
+*CONTEXT_CMDLINE = *Amanda::Utilc::CONTEXT_CMDLINE;
+*CONTEXT_DAEMON = *Amanda::Utilc::CONTEXT_DAEMON;
+*CONTEXT_SCRIPTUTIL = *Amanda::Utilc::CONTEXT_SCRIPTUTIL;
+*AF_INET = *Amanda::Utilc::AF_INET;
+*STREAM_BUFSIZE = *Amanda::Utilc::STREAM_BUFSIZE;
@EXPORT_OK = ();
%EXPORT_TAGS = ();
-use Amanda::Debug qw(:init);
-use Carp;
-use POSIX qw(:fcntl_h);
=head1 NAME
Application initialization generally looks like this:
use Amanda::Config qw( :init );
- use Amanda::Util qw( :check_running_as_flags );
+ use Amanda::Util qw( :constants );
use Amanda::Debug;
- Amanda::Util::setup_application("myapp", "server", "cmdline");
+ Amanda::Util::setup_application("myapp", "server", $CONTEXT_CMDLINE);
# .. command-line processing ..
Amanda::Config::config_init(...);
Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
+ # ..
+ Amanda::Util::finish_application();
=over
-=item C<setup_application($name, $type, $context)>
+=item setup_application($name, $type, $context)
Set up the operating environment for an application, without requiring
any configuration.
+C<$name> is the name of the application, used in log messages, etc.
+C<$type> is usualy one of "server" or "client". It specifies the
+subdirectory in which debug logfiles will be created. C<$context>
+indicates the usual manner in which this application is invoked; one
+of C<$CONTEXT_CMDLINE> for a user-invoked command-line utility (e.g.,
+C<amadmin>) which should send human-readable error messages to stderr;
+C<$CONTEXT_DAEMON> for a program started by C<amandad>, e.g.,
+C<sendbackup>; or C<$CONTEXT_SCRIPTUTIL> for a small program used from
+shell scripts, e.g., C<amgetconf>
+
+Based on C<$type> and C<$context>, this function does the following:
+
=over
-=item C<$name> is the name of the application, used in log messages, etc.
+=item *
+
+sets up debug logging;
+
+=item *
-=item C<$type> is one of "server" or "client".
+configures internationalization
-=item C<$context> is one of "cmdline" for a user-invoked command-line
-utility (e.g., C<amadmin>) or "daemon" for a program started by
-C<amandad>. (TODO: daemon is not supported yet)
+=item *
+
+sets the umask;
+
+=item *
+
+sets the current working directory to the debug or temporary
+directory;
+
+=item *
+
+closes any unnecessary file descriptors as a security meaasure;
+
+=item *
+
+ignores C<SIGPIPE>; and
+
+=item *
+
+sets the appropriate target for error messages.
=back
-Based on C<$type> and C<$context>, this function does the following:
+=item finish_setup($running_as_flags)
+
+Perform final initialization tasks that require a loaded
+configuration. Specifically, move the debug log into a
+configuration-specific subdirectory, and check that the current userid
+is appropriate for this applciation.
+
+The user is specified by one of the following flags, which are
+available in export tag C<:check_running_as_flags>:
+
+ $RUNNING_AS_ANY # any user is OK
+ $RUNNING_AS_ROOT # root
+ $RUNNING_AS_DUMPUSER # dumpuser, from configuration
+ $RUNNING_AS_DUMPUSER_PREFERRED # dumpuser, but client_login is OK too
+ $RUNNING_AS_CLIENT_LOGIN # client_login (--with-user at build time)
+
+If the flag C<$RUNNING_AS_UID_ONLY> is bit-or'd into
+C<$running_as_flags>, then the euid is ignored; this is used for
+programs that expect to be setuid-root.
+
+=item finish_application()
+
+Remove old debug files.
+All applications should call this before exiting.
+
+=item get_original_cwd()
+
+Return the original current directory with C<get_original_cwd>.
+
+=item version_opt()
+
+Print the version and exit. This is intended to be used in C<GetOptions> invocations, e.g.,
+
+ GetOptions(
+ # ...
+ 'version' => \&Amanda::Util::version_opt,
+ );
+
+=back
+
+=head1 File Handling
+
+These functions read and write the entire requested size to a file
+descriptor, even if the underlying syscall returns early. Note that
+they do not operate on Perl file handles.
+
+If fewer than C<$size> bytes are written, C<full_write> returns the
+number of bytes actually written and sets C<$!> appropriately. When
+reading, if fewer than C<$size> bytes are read due to a normal EOF,
+then C<$!> is zero; otherwise, it contains the appropriate error
+message.
+
+Unlike C<POSIX::read>, C<full_read> returns a scalar containing the
+bytes it read from the file descriptor.
+
+=over
+
+=item full_read($fd, $size)
+
+=item full_write($fd, $buf, $size)
+
+=back
+
+=head1 Miscellaneous Utilities
+
+=over
+
+=item safe_env()
+
+Return a "safe" environment hash. For non-setuid programs, this means
+filtering out any localization variables.
+
+=item get_fs_usage(file, disk)
+
+This is a wrapper around the Gnulib function of the same name. On success, it returns
+a hash with keys:
+
+ blocksize Size of a block
+ blocks Total blocks on disk
+ bfree Free blocks available to superuser
+ bavail Free blocks available to non-superuser
+ bavail_top_bit_set 1 if fsu_bavail represents a value < 0
+ files Total file nodes
+ ffree Free file nodes
+
+On failure, it returns nothing, and C<$!> should be set. If C<$!> is 0, then
+this is a system which cannot measure usage without a C<disk> argument, which
+this wrapper does not support.
+
+=item is_pid_alive(pid)
+
+Return 1 is the process with that pid is still alive.
+
+=item weaken_ref($ref)
+
+This is exactly the same as C<Scalar::Util::weaken>, but available in all
+supported versions of perl.
+
+=item gettimeofday()
+
+Return the number of microseconds since the UNIX epoch.
+
+=item fsync($fd)
+
+Invoke the C<fsync> syscall.
+
+=item set_blocking($fd, $blocking)
+
+Set or clear the C<O_NONBLOCK> fd flag on $fd; returns a negative value on
+failure, or 0 on success.
+
+=item openbsd_fd_inform()
+
+Due to a particularly poor user-space implementation of threading on OpenBSD,
+executables that are run with nonstandard file descriptors open (fd > 2) find
+those descriptors to be in a nonblocking state. This particularly affects
+amandad services, which begin with several file descriptors in the 50's open.
+
+This function "informs" the C library about these descriptors by making an
+C<fcntl(fd, F_GETFL)> call. This is otherwise harmless, and is only perfomed
+on OpenBSD.
+
+=item built_with_component($comp)
+
+Returns true if Amanda was built with the given component. Component names are
+in C<config/amanda/components.m4>.
+
+=back
+
+=head1 TCP Utilities
+
+These are thin wrappers over functions in C<common-src/stream.h> and other related
+functions.
+
+=over
+
+=item stream_server
+
+ my $family = $Amanda::Util::AF_INET;
+ my $bufsize = $Amanda::Util::STREAM_BUFSIZE;
+ my ($listensock, $port) = Amanda::Util::stream_server(
+ $family, $bufsize, $bufsize, $priv);
+
+This function creates a new socket and binds it to a port, returning both the
+socket and port. If the socket is -1, then an error occurred and is available
+in C<$!>. The constants C<$AF_INET> and C<$STREAM_BUFSIZE> are universally
+used when calling this function. If the final argument, C<$priv>, is true,
+then a the function opens a privileged port (below 1024).
+
+=item stream_accept
+
+ my $sock = Amanda::Util::stream_accept(
+ $listen_sock, $timeout, $bufsize, $bufsize);
+
+This function accepts a connection on a listening socket. If the connection is
+not made within C<$timeout> seconds, or some other error occurs, then the
+function returns -1. The bufsize arguments are applied to the new socket.
+
+=item check_security
+
+ my $ok = Amanda::Util::check_security($socket, $userstr);
+
+This function takes a socket descriptor and a string of the form C<"USER foo">
+and performs BSD-style checks on that descriptor. These include verifying
+round-trip DNS sanity; check that the user is in C<.rhosts> or C<.amandahosts>,
+and checking that the remote port is reserved. Returns an error string on
+error, or C<undef> on success.
+
+=back
+
+=head1 String Utilities
=over
-=item sets up debug logging;
+=item quote_string($str)
+
+Quote a string using Amanda's quoting algorithm. Strings with no
+whitespace, control, or quote characters are returned unchanged. An
+empty string is represented as the two-character string C<"">.
+Otherwise, tab, newline, carriage return, form-feed, backslash, and
+double-quote (C<">) characters are escaped with a backslash and the
+string is surrounded by double quotes.
-=item configures internationalization
+=item unquote_string($str)
-=item sets the umask;
+Unquote a string as quoted with C<quote_string>.
-=item sets the current working directory to the debug or temporary directory;
+=item skip_quoted_string($str)
-=item closes any unnecessary file descriptors as a security meaasure;
+my($q, $remaider) = skip_quoted_string($str)
-=item ignores C<SIGPIPE>; and
+Return the first quoted string and the remainder of the string, as separated by
+any whitespace. Note that the remainder of the string does not include the
+single separating whitespace character, but will include any subsequent
+whitespace. The C<$q> is not unquoted.
-=item sets the appropriate target for error messages.
+=item C<split_quoted_strings($str)>
+
+Split string on unquoted whitespace. Multiple consecutive spaces are I<not>
+collapsed into a single space: C<"x y"> (with two spaces) parses as C<( "x",
+"", "y")>. The strings are unquoted before they are returned. An empty string
+is split into C<( "" )>. This method is generally used for parsing IPC messages,
+where blank space is significant and well-controlled.
+
+=item C<split_quoted_strings_friendly($str)>
+
+Similar to C<split_quoted_strings>, but intended for user-friendly uses. In
+particular, this function treats any sequence of zero or more whitespace
+characters as a separator, rather than the more strict interpretation applied
+by C<split_quoted_strings>. All of the strings are unquoted.
+
+All of these quoting-related functions are available under the export
+tag C<:quoting>.
+
+=item hexencode($str)
+
+Encode a string using URI-style hexadecimal encoding.
+Non-alphanumeric characters will be replaced with "%xx"
+where "xx" is the two-digit hexadecimal representation of the character.
+
+=item hexdecode($str)
+
+Decode a string using URI-style hexadecimal encoding.
+
+Both C<hexencode> and C<hexdecode> are available under the export tag C<:encoding>
+
+=item expand_braced_alternates($str)
+=item collapse_braced_alternates(\@list)
+
+These two functions handle "braced alternates", which is a syntax
+borrowed, partially, from shells. Comma-separated strings enclosed in
+curly braces expand into multiple alternatives for the entire string.
+For example:
+
+ "{foo,bar,bat}" [ "foo", "bar", "bat" ]
+ "foo{1,2}bar" [ "foo1bar", "foo2bar" ]
+ "foo{1\,2,3}bar" [ "foo1,2bar", "foo3bar" ]
+ "{a,b}-{1,2}" [ "a-1", "a-2", "b-1", "b-2" ]
+
+Note that nested braces are not processed. Braces, commas, and
+backslashes may be escaped with backslashes.
+
+As a special case for numeric ranges, if the braces contain only digits
+followed by two dots followed by more digits, and the digits sort in the
+correct order, then they will be treated as a sequence. If the first number in
+the sequence has leading zeroes, then all generated numbers will have that
+length, padded with leading zeroes.
+
+ "tape-{01..10}" [ "tape-01", "tape-02", "tape-03", "tape-04",
+ "tape-05", "tape-06", "tape-07", "tape-08",
+ "tape-09", "tape-10" ]
+
+On error, C<expand_braced_altnerates> returns undef. These two functions are
+available in the export tag C<:alternates>.
+
+=item generate_timestamp()
+
+Generate a timestamp from the current time, obeying the
+'USETIMESTAMPS' config parameter. The Amanda configuration must
+already be loaded.
+
+=item sanitise_filename($fn)
+
+"Santitises" a filename by replacing any characters that might have special
+meaning to a filesystem with underscores. This operation is I<not> reversible,
+and distinct input filenames I<may> produce identical output filenames.
+
+=item unmarshal_tapespec($tapespec)
+=item marshal_tapespec($filelist)
+
+These functions convert between a tapespec -- formerly, and confusingly, called
+a "tapelist" -- and a perl data structure like
+
+ [ $label1 => [ $filenum1, $filenum2, .. ],
+ $label2 => [ $filenum1, $filenum2, .. ],
+ ]
+
+Note that a non-tapespec C<$string> will be unmarshalled as C<[ $string, [] ]>.
=back
+=head1 Locking Files
+
+Amanda provides a basic mechanism to lock a file and read its contents. This
+uses operating-system facilities to acquire an advisory lock, so non-Amanda
+applications are not prevented from modifying the file while it is locked.
+
+To create a lock object, call the C<file_lock> constructor, passing the
+filename to lock:
+
+ my $fl = Amanda::Util::file_lock->new($filename)
+
+then, lock the file:
+
+ $fl->lock();
+
+which also reads the contents of the file into memory, accessible via
+
+ my $state = $fl->data();
+
+to change the file contents, call C<write>:
+
+ $fl->write($new_contents);
+
+and unlock the lock with
+
+ $fl->unlock();
+
+Note that the file will be automatically unlocked if the C<file_lock> object is
+garbage-collected.
+
+=head1 Simple File Reading & Writing
+
+For reading small files directly into memory with little code
+overhead, we can use C<slurp>.
+
+ my $data = slurp $filename;
+
+After processing the data, we can write it back to file with C<burp>. This
+function always completely overwrites the file.
+
+ burp $filename, $header;
+
+These functions can (and should) be exported to the main namespace
+
=cut
+
+
+use Amanda::Debug qw(:init);
+use Amanda::Config qw(:getconf);
+use warnings;
+use Carp;
+use POSIX qw( :fcntl_h :errno_h );
+use POSIX qw( strftime );
+use Amanda::Constants;
+use Amanda::Process;
+
# private package variables
my $_pname;
my $_ptype;
$_ptype = $type;
$_pcontext = $context;
- # and let the C side know about the pname
+ # and let the C side know about them too
set_pname($name);
+ set_ptype($type);
+ set_pcontext($context);
safe_cd(); # (also sets umask)
check_std_fds();
- # set up debugging for this application type
- dbopen($type);
+ # set up debugging, now that we have a name, type, and context
+ debug_init();
# ignore SIGPIPE
$SIG{'PIPE'} = 'IGNORE';
-
- set_erroutput_type($type, $context);
}
-=item C<finish_setup($running_as_flags)>
-
-Perform final initialization tasks that require a loaded configuration.
-Specifically, move the debug log into a configuration-specific
-subdirectory, and check that the current userid is appropriate for
-this applciation.
-
-The user is specified by one of the following flags, which are
-available in export tag C<:check_running_as_flags>:
-
- $RUNNING_AS_ROOT # root
- $RUNNING_AS_DUMPUSER # dumpuser, from configuration
- $RUNNING_AS_DUMPUSER_PREFERRED # dumpuser, but client_login is OK too
- $RUNNING_AS_CLIENT_LOGIN # client_login (--with-user at build time)
-
-If the flag C<$RUNNING_AS_UID_ONLY> is bit-or'd into C<$running_as_flags>, then
-the euid is ignored; this is used for programs that expect to be setuid-root.
-
-=cut
-
sub finish_setup {
my ($running_as) = @_;
check_running_as($running_as);
}
-=item safe_env
+sub finish_application {
+ dbclose();
+}
+
+sub version_opt {
+ print "$_pname-$Amanda::Constants::VERSION\n";
+ exit 0;
+}
-Return a "safe" environment hash. For non-setuid programs, this means filtering out any
-localization variables.
-=cut
+push @EXPORT_OK, qw(get_original_cwd);
+push @{$EXPORT_TAGS{"util"}}, qw(get_original_cwd);
sub safe_env {
my %rv = %ENV;
return @result;
}
+push @EXPORT_OK, qw($RUNNING_AS_ANY);
+push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_ANY);
+
+$_running_as_flags_VALUES{"RUNNING_AS_ANY"} = $RUNNING_AS_ANY;
+
push @EXPORT_OK, qw($RUNNING_AS_ROOT);
push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_ROOT);
$_running_as_flags_VALUES{"RUNNING_AS_UID_ONLY"} = $RUNNING_AS_UID_ONLY;
+#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;
+}
+
+
sub check_std_fds {
fcntl(STDIN, F_GETFD, 0) or critical("Standard input is not open");
fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open");
fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");
}
+
1;
projects / debian / amanda / blobdiff