/*
- * 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., 505 N Mathlida Ave, Suite 120
+ * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
* Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
*/
%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);
-
-=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( :check_running_as_flags );
- use Amanda::Debug;
-
- Amanda::Util::setup_application("myapp", "server", "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.
-
-=over
-
-=item C<$name> is the name of the application, used in log messages, etc.
-
-=item C<$type> is one of "server" or "client".
-
-=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)
-
-=back
-
-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;
$_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();
+}
-Return a "safe" environment hash. For non-setuid programs, this means filtering out any
-localization variables.
+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 %{
sub safe_env {
my %rv = %ENV;
%}
amglue_add_flag_tag_fns(running_as_flags);
+amglue_add_constant(RUNNING_AS_ANY, running_as_flags);
amglue_add_constant(RUNNING_AS_ROOT, running_as_flags);
amglue_add_constant(RUNNING_AS_DUMPUSER, running_as_flags);
amglue_add_constant(RUNNING_AS_DUMPUSER_PREFERRED, running_as_flags);
amglue_add_constant(RUNNING_AS_CLIENT_LOGIN, running_as_flags);
amglue_add_constant(RUNNING_AS_UID_ONLY, running_as_flags);
+amglue_copy_to_tag(running_as_flags, constants);
-/* -------------------------------------------------------------------------
- * Functions below this line are only meant to be called within this module;
- * do not call them externally. */
+amglue_add_enum_tag_fns(pcontext_t);
+amglue_add_constant(CONTEXT_DEFAULT, pcontext_t);
+amglue_add_constant(CONTEXT_CMDLINE, pcontext_t);
+amglue_add_constant(CONTEXT_DAEMON, pcontext_t);
+amglue_add_constant(CONTEXT_SCRIPTUTIL, pcontext_t);
+amglue_copy_to_tag(pcontext_t, constants);
-void set_pname(char *name);
-void safe_cd(void);
+%perlcode %{
+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;
+ }
-void check_running_as(running_as_flags who);
+ return join('', @bufs);
+}
-/* Set erroutput_type as appropriate for this process type and context.
- *
- * @param type: process type
- * @param context: process context
+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;
+}
+
+%}
+
+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 *);
+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 split_quoted_strings_friendly);
+amglue_export_tag(alternates, expand_braced_alternates collapse_braced_alternates);
+
+%perlcode %{
+
+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;
+}
+
+%}
+
+/* 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 %{
-void
-set_erroutput_type(char *type, char *context)
+int
+set_blocking(int fd, gboolean blocking)
{
- if (strcmp(context, "cmdline") == 0) {
- erroutput_type = ERR_INTERACTIVE;
- } else if (strcmp(context, "daemon") == 0) {
- if (strcmp(type, "server") == 0) {
- erroutput_type = ERR_INTERACTIVE|ERR_AMANDALOG;
- } else if (strcmp(type, "client") == 0) {
- erroutput_type = ERR_INTERACTIVE|ERR_SYSLOG;
+ 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 lock_wr();
+ int lock_rd();
+ int unlock();
+ int locked();
+
+ %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;
+}
+
+%}
+
+amglue_export_ok(
+ match_host match_disk match_datestamp match_level
+);
+
+gboolean match_host(char *pat, char *value);
+gboolean match_disk(char *pat, char *value);
+gboolean match_datestamp(char *pat, char *value);
+gboolean match_level(char *pat, char *value);
+
+
+/* -------------------------------------------------------------------------
+ * Functions below this line are only meant to be called within this module;
+ * 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);
/* Check that fd's 0, 1, and 2 are open, calling critical() if not.
*/
fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open");
fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");
}
+
%}
projects / debian / amanda / blobdiff