X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=perl%2FAmanda%2FUtil.swg;h=e325a9e0a918bad8ac0e5ed4bb549f55dc52d3f4;hb=c6f0a88c567f8536c498f554285aed1f8150da18;hp=e67a471d7e3f1526c3fbf1705493707975662380;hpb=94a044f90357edefa6f4ae9f0b1d5885b0e34aee;p=debian%2Famanda diff --git a/perl/Amanda/Util.swg b/perl/Amanda/Util.swg index e67a471..e325a9e 100644 --- a/perl/Amanda/Util.swg +++ b/perl/Amanda/Util.swg @@ -1,20 +1,20 @@ /* - * 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 */ @@ -22,75 +22,32 @@ %include "amglue/amglue.swg" %include "exception.i" +%include "Amanda/Util.pod" + %{ +#include +#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 - -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) or "daemon" for a program started by -C. (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; 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; @@ -110,41 +67,21 @@ sub setup_application { $_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 - -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) = @_; @@ -157,13 +94,20 @@ sub finish_setup { 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; @@ -180,41 +124,538 @@ sub safe_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(/(? $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. */ @@ -224,4 +665,5 @@ sub check_std_fds { fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open"); fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open"); } + %}