/*
 * Copyright (c) 2009, 2010 Zmanda, Inc.  All Rights Reserved.
 *
 * This program is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License version 2 as published
 * by the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 * for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
 *
 * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
 * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
 */

%perlcode %{

=head1 NAME

Amanda::Util - Runtime support for Amanda applications

=head1 Application Initialization

Application initialization generally looks like this:

  use Amanda::Config qw( :init );
  use Amanda::Util qw( :constants );
  use Amanda::Debug;

  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 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 *

sets up debug logging;

=item *

configures internationalization

=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

=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 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 unquote_string($str)

Unquote a string as quoted with C<quote_string>.

=item skip_quoted_string($str)

my($q, $remaider) = skip_quoted_string($str)

Return the first quoted string and the remainder of the string.

=item C<split_quoted_strings($str)>

Split string on unquoted whitespace.  Multiple consecutive spaces are 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<( "" )>.

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.  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

%}