/*
- * Copyright (c) Zmanda, Inc. All Rights Reserved.
+ * Copyright (c) 2007, 2008, 2009, 2010 Zmanda, Inc. All Rights Reserved.
*
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License version 2.1
- * as published by the Free Software Foundation.
+ * 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 library is distributed in the hope that it will be useful, but
+ * 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 Lesser General Public
- * License for more details.
+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
*
- * You should have received a copy of the GNU Lesser General Public License
- * along with this library; if not, write to the Free Software Foundation,
- * Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+ * 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 Mathlida Ave, Suite 300
- * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
+ * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
+ * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
*/
%module "Amanda::Util"
%include "amglue/amglue.swg"
%include "exception.i"
+%include "Amanda/Util.pod"
+
%{
+#include <unistd.h>
+#include "amglue.h"
#include "debug.h"
+#include "full-read.h"
+#include "full-write.h"
+#include "fsusage.h"
+#include "stream.h"
/* use a relative path here to avoid conflicting with Perl's util.h. */
#include "../common-src/util.h"
#include "file.h"
+#include "sockaddr-util.h"
%}
%perlcode %{
+
use Amanda::Debug qw(:init);
use Amanda::Config qw(:getconf);
+use warnings;
use Carp;
-use POSIX qw( :fcntl_h strftime );
-
-=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);
-
-=over
-
-=item C<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
-
-=cut
+use POSIX qw( :fcntl_h :errno_h );
+use POSIX qw( strftime );
+use Amanda::Constants;
+use Amanda::Process;
# private package variables
my $_pname;
$SIG{'PIPE'} = 'IGNORE';
}
-=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_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.
-
-=cut
-
sub finish_setup {
my ($running_as) = @_;
check_running_as($running_as);
}
-=item C<get_original_cwd()>
+sub finish_application {
+ dbclose();
+}
-Return the original current directory with C<get_original_cwd>.
+sub version_opt {
+ print "$_pname-$Amanda::Constants::VERSION\n";
+ exit 0;
+}
-=cut
%}
char *get_original_cwd(void);
amglue_export_tag(util, get_original_cwd);
%perlcode %{
-=head1 Miscellaneous Utilities
-
-=item C<safe_env()>
-
-Return a "safe" environment hash. For non-setuid programs, this means filtering out any
-localization variables.
-
-=cut
-
sub safe_env {
my %rv = %ENV;
amglue_copy_to_tag(pcontext_t, constants);
%perlcode %{
-=item C<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 C<unquote_string($str)>
-
-Unquote a string as quoted with C<quote_string>.
+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;
+ }
-=item C<skip_quoted_string($str)>
+ return join('', @bufs);
+}
-my($q, $remaider) = skip_quoted_string($str)
+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;
+ }
-Return the first quoted string and the remainder of the string.
+ $count -= $n_written;
+ $total += $n_written;
-Both C<quote_string>, C<unquote_string> and C<skip_quoted_string> are
-available under the export tag C<:quoting>.
+ if ($count) {
+ $buf = substr($buf, $n_written);
+ }
+ }
-=cut
+ return $total;
+}
sub skip_quoted_string {
my $str = shift;
$c = substr $str, $i, 1;
}
my $quoted_string = substr $str, 0, $i;
- my $remainder = substr $str, $i+1;
+ my $remainder = undef;
+ if (length($str) > $i) {
+ $remainder = substr $str, $i+1;
+ }
return ($quoted_string, $remainder);
}
%}
+amglue_export_ok(slurp);
+amglue_export_ok(burp);
+amglue_export_ok(safe_overwrite_file);
+
+%perlcode %{
+
+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;
+}
+
+%}
+
+%typemap (in) GPtrArray * {
+ AV *av;
+ guint len;
+ int i;
+
+ if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
+ SWIG_exception(SWIG_TypeError, "Expected an arrayref");
+ }
+ av = (AV *)SvRV($input);
+
+ len = av_len(av)+1; /* av_len(av) is like $#av */
+ $1 = g_ptr_array_sized_new(len);
+ for (i = 0; i < len; i++) {
+ SV **elt = av_fetch(av, i, 0);
+ if (!elt || !SvPOK(*elt)) {
+ SWIG_exception(SWIG_TypeError, "Non-string in arrayref");
+ }
+ g_ptr_array_add($1, SvPV_nolen(*elt)); /* TODO: handle unicode here */
+ }
+}
+%typemap (freearg) GPtrArray * {
+ g_ptr_array_free($1, FALSE);
+}
+
+%typemap (out) GPtrArray * {
+ if ($1) {
+ guint i;
+ for (i = 0; i < $1->len; i++) {
+ $result = sv_2mortal(newSVpv(g_ptr_array_index($1, i), 0));
+ argvi++;
+ }
+ g_ptr_array_free($1, TRUE);
+ } else {
+ $result = &PL_sv_undef;
+ argvi++;
+ }
+}
+
+/* for split_quoted_strings */
+%typemap(out) gchar ** {
+ gchar **iter;
+
+ if ($1) {
+ /* Count the DeviceProperties */
+ EXTEND(SP, g_strv_length($1)); /* make room for return values */
+
+ /* Note that we set $result several times. the nature of
+ * SWIG's wrapping is such that incrementing argvi points
+ * $result to the next location in perl's argument stack.
+ */
+
+ for (iter = $1; *iter; iter++) {
+ $result = sv_2mortal(newSVpv(*iter, 0));
+ argvi++;
+ }
+ }
+}
+
+%rename(hexencode) hexencode_string;
+char *hexencode_string(char *);
+%rename(hexdecode) perl_hexdecode_string;
+char *perl_hexdecode_string(char *);
+%{
+char *perl_hexdecode_string(const char *str) {
+ GError *err = NULL;
+ char *tmp;
+ tmp = hexdecode_string(str, &err);
+ if (err) {
+ g_free(tmp);
+ croak_gerror("Amanda util: hexdecode", &err);
+ }
+ return tmp;
+}
+%}
+amglue_export_tag(encoding, hexencode hexdecode);
+
char *sanitise_filename(char *inp);
char *quote_string(char *);
char *unquote_string(char *);
-amglue_export_tag(quoting, quote_string unquote_string skip_quoted_string sanitise_filename);
+GPtrArray *expand_braced_alternates(char *);
+%newobject collapse_braced_alternates;
+char *collapse_braced_alternates(GPtrArray *source);
+gchar **split_quoted_strings(const gchar *string);
+amglue_export_tag(quoting, quote_string unquote_string skip_quoted_string sanitise_filename split_quoted_strings);
+amglue_export_tag(alternates, expand_braced_alternates collapse_braced_alternates);
%perlcode %{
-=item C<generate_timestamp()>
-
-Generate a timestamp from the current time, obeying the 'USETIMESTAMPS'
-config parameter. The Amanda configuration must already be loaded.
-
-=cut
sub generate_timestamp {
# this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
return strftime "%Y%m%d", localtime;
}
}
+
+sub built_with_component {
+ my ($component) = @_;
+ my @components = split / +/, $Amanda::Constants::AMANDA_COMPONENTS;
+ return grep { $_ eq $component } @components;
+}
+
+%}
+
+/* interface to gnulib's fsusage */
+%typemap(in,numinputs=0) (struct fs_usage *fsp)
+ (struct fs_usage fsu) {
+ bzero(&fsu, sizeof(fsu));
+ $1 = &fsu;
+}
+
+%typemap(argout) (struct fs_usage *fsp) {
+ SV *sv;
+ HV *hv;
+
+ /* if there was an error, assume that fsu_blocksize isn't changed,
+ * and return undef. */
+ if ($1->fsu_blocksize) {
+ SP += argvi; PUTBACK; /* save the perl stack so amglue_newSVi64 doesn't kill it */
+ hv = (HV *)sv_2mortal((SV *)newHV());
+ hv_store(hv, "blocksize", 9, amglue_newSVi64($1->fsu_blocksize), 0);
+ hv_store(hv, "blocks", 6, amglue_newSVi64($1->fsu_blocks), 0);
+ hv_store(hv, "bfree", 5, amglue_newSVi64($1->fsu_bfree), 0);
+ hv_store(hv, "bavail", 6, amglue_newSVi64($1->fsu_bavail), 0);
+ hv_store(hv, "bavail_top_bit_set", 18, newSViv($1->fsu_bavail_top_bit_set), 0);
+ hv_store(hv, "files", 5, amglue_newSVi64($1->fsu_files), 0);
+ hv_store(hv, "ffree", 5, amglue_newSVi64($1->fsu_ffree), 0);
+
+ $result = newRV((SV *)hv);
+ SPAGAIN; SP -= argvi;
+ argvi++;
+ }
+}
+
+%rename(get_fs_usage) get_fs_usage_;
+%inline %{
+void get_fs_usage_(const char *file, struct fs_usage *fsp)
+{
+ int rv = get_fs_usage(file, NULL, fsp);
+ if (rv == -1)
+ /* signal an error to the typemap */
+ fsp->fsu_blocksize = 0;
+}
+%}
+
+/*
+ * Operations that should be in Perl but aren't
+ */
+
+int fsync(int fd);
+
+/* Perl's fcntl only operates on file handles */
+%inline %{
+int
+set_blocking(int fd, gboolean blocking)
+{
+ int flags = fcntl(fd, F_GETFL, 0);
+ if (flags < 0)
+ return flags;
+ if (blocking)
+ flags &= ~O_NONBLOCK;
+ else
+ flags |= O_NONBLOCK;
+ flags = fcntl(fd, F_SETFL, flags);
+ if (flags < 0)
+ return flags;
+ return 0;
+}
+%}
+
+/*
+ * Locking (see amflock.h)
+ */
+
+/* SWIG prepends the struct name to the member function name, which
+ * conflicts with the underlying function names */
+
+typedef struct file_lock {
+ %extend {
+ file_lock(const char *filename) {
+ return file_lock_new(filename);
+ }
+
+ ~locked_data() {
+ file_lock_free(self);
+ }
+
+ int lock();
+ int unlock();
+
+ %typemap(in) (const char *data, size_t len) {
+ $1 = SvPV($input, $2);
+ }
+
+ int write(const char *data, size_t len);
+
+ /* get the data as an SV */
+ %typemap(out) (SV *) { $result = $1; argvi++; };
+ SV *data() {
+ if (self->data) {
+ return newSVpvn(self->data, self->len);
+ } else {
+ return &PL_sv_undef;
+ }
+ }
+ %typemap(out) (SV *);
+ }
+} file_lock;
+
+%perlcode %{
+
+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;
+
+}
+%}
+
+/* Interesting story: Perl added a sv_rvweaken function in 5.6.0 (or earlier?), but
+ * did not include this functionality in Scalar::Util until later. It doesn't make
+ * much sense, does it? */
+amglue_export_ok(weaken_ref)
+%typemap(in) SV *rv "$1 = $input;"
+%inline %{
+void weaken_ref(SV *rv) {
+ sv_rvweaken(rv);
+}
+%}
+
+%rename(gettimeofday) gettimeofday_for_perl;
+%inline %{
+static guint64 gettimeofday_for_perl(void)
+{
+ GTimeVal t;
+ g_get_current_time(&t);
+ return (guint64)t.tv_sec * G_USEC_PER_SEC + (guint64)t.tv_usec;
+}
+%}
+
+void openbsd_fd_inform(void);
+
+/*
+ * Streams
+ *
+ * TODO: this should move to Amanda::Security when the rest of the Security API
+ * is available from Perl.
+ */
+
+enum { AF_INET };
+enum { STREAM_BUFSIZE };
+%typemap(in, numinputs=0) in_port_t *port_ARGOUT (in_port_t port) {
+ $1 = &port;
+}
+%typemap(argout) in_port_t *port_ARGOUT {
+ $result = sv_2mortal(newSViv(*$1));
+ argvi++;
+}
+/* avoid BigInts for socket fd's */
+%{ typedef int socketfd; %}
+%typemap(out) socketfd {
+ $result = sv_2mortal(newSViv($1));
+ argvi++;
+}
+socketfd stream_server(int family, in_port_t *port_ARGOUT, size_t sendsize,
+ size_t recvsize, gboolean privileged);
+
+socketfd stream_accept(int fd, int timeout, size_t sendsize, size_t recvsize);
+
+%newobject check_security_fd;
+%rename(check_security) check_security_fd;
+%inline %{
+char *check_security_fd(int fd, char *userstr)
+{
+ socklen_t_equiv i;
+ struct sockaddr_in addr;
+ char *errstr;
+
+ /* get the remote address */
+ i = SIZEOF(addr);
+ if (getpeername(fd, (struct sockaddr *)&addr, &i) == -1) {
+ return g_strdup_printf("getpeername: %s", strerror(errno));
+ }
+
+ /* require IPv4 and not port 20 -- apparently this was a common attack
+ * vector for much older Amandas */
+ if ((addr.sin_family != (sa_family_t)AF_INET)
+ || (ntohs(addr.sin_port) == 20)) {
+ return g_strdup_printf("connection rejected from %s family %d port %d",
+ inet_ntoa(addr.sin_addr), addr.sin_family, htons(addr.sin_port));
+ }
+
+ /* call out to check_security */
+ if (!check_security((sockaddr_union *)&addr, userstr, 0, &errstr))
+ return errstr;
+
+ return NULL;
+}
+%}
+amglue_export_ok(
+ stream_server stream_accept check_security);
+amglue_export_tag(constants,
+ $AF_INET $STREAM_BUFSIZE);
+
+%perlcode %{
+
+# 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;
+}
+
%}
/* -------------------------------------------------------------------------
* do not call them externally. */
void set_pname(char *name);
+char *get_pname();
void set_ptype(char *type);
+char *get_ptype();
void set_pcontext(pcontext_t context);
+pcontext_t get_pcontext();
void safe_cd(void);
void check_running_as(running_as_flags who);
fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");
}
-=back
-
-=cut
%}
projects / debian / amanda / blobdiff