2 * Copyright (c) 2007-2012 Zmanda, Inc. All Rights Reserved.
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
19 * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
22 %module "Amanda::Util"
23 %include "amglue/amglue.swg"
24 %include "exception.i"
26 %include "Amanda/Util.pod"
32 #include "full-read.h"
33 #include "full-write.h"
36 /* use a relative path here to avoid conflicting with Perl's util.h. */
37 #include "../common-src/util.h"
39 #include "sockaddr-util.h"
44 use Amanda::Debug qw(:init);
45 use Amanda::Config qw(:getconf);
48 use POSIX qw( :fcntl_h :errno_h );
49 use POSIX qw( strftime );
50 use Amanda::Constants;
53 # private package variables
58 sub setup_application {
59 my ($name, $type, $context) = @_;
62 croak("no name given") unless ($name);
63 croak("no type given") unless ($type);
64 croak("no context given") unless ($context);
66 # store these as perl values
69 $_pcontext = $context;
71 # and let the C side know about them too
74 set_pcontext($context);
76 safe_cd(); # (also sets umask)
79 # set up debugging, now that we have a name, type, and context
83 $SIG{'PIPE'} = 'IGNORE';
87 my ($running_as) = @_;
89 my $config_name = Amanda::Config::get_config_name();
92 dbrename($config_name, $_ptype);
95 check_running_as($running_as);
98 sub finish_application {
103 print "$_pname-$Amanda::Constants::VERSION\n";
108 char *get_original_cwd(void);
109 amglue_export_tag(util, get_original_cwd);
115 delete @rv{qw(IFS CDPATH ENV BASH_ENV LANG)};
117 # delete all LC_* variables
118 for my $var (grep /^LC_/, keys %rv) {
127 amglue_add_flag_tag_fns(running_as_flags);
128 amglue_add_constant(RUNNING_AS_ANY, running_as_flags);
129 amglue_add_constant(RUNNING_AS_ROOT, running_as_flags);
130 amglue_add_constant(RUNNING_AS_DUMPUSER, running_as_flags);
131 amglue_add_constant(RUNNING_AS_DUMPUSER_PREFERRED, running_as_flags);
132 amglue_add_constant(RUNNING_AS_CLIENT_LOGIN, running_as_flags);
133 amglue_add_constant(RUNNING_AS_UID_ONLY, running_as_flags);
134 amglue_copy_to_tag(running_as_flags, constants);
136 amglue_add_enum_tag_fns(pcontext_t);
137 amglue_add_constant(CONTEXT_DEFAULT, pcontext_t);
138 amglue_add_constant(CONTEXT_CMDLINE, pcontext_t);
139 amglue_add_constant(CONTEXT_DAEMON, pcontext_t);
140 amglue_add_constant(CONTEXT_SCRIPTUTIL, pcontext_t);
141 amglue_copy_to_tag(pcontext_t, constants);
145 my ($fd, $count) = @_;
150 my $n_read = POSIX::read($fd, $b, $count);
151 if (!defined $n_read) {
152 next if ($! == EINTR);
154 } elsif ($n_read == 0) {
161 return join('', @bufs);
165 my ($fd, $buf, $count) = @_;
169 my $n_written = POSIX::write($fd, $buf, $count);
170 if (!defined $n_written) {
171 next if ($! == EINTR);
173 } elsif ($n_written == 0) {
177 $count -= $n_written;
178 $total += $n_written;
181 $buf = substr($buf, $n_written);
188 sub skip_quoted_string {
194 my $c = substr $str, $i, 1;
195 while ($c ne "" && !($iq == 0 && $c =~ /\s/)) {
198 } elsif ($c eq '\\') {
202 $c = substr $str, $i, 1;
204 my $quoted_string = substr $str, 0, $i;
205 my $remainder = undef;
206 if (length($str) > $i) {
207 $remainder = substr $str, $i+1;
210 return ($quoted_string, $remainder);
213 sub split_quoted_string_friendly {
220 (my $elt, $str) = skip_quoted_string($str);
221 push @result, unquote_string($elt);
222 $str =~ s/^\s+// if $str;
230 amglue_export_ok(slurp);
231 amglue_export_ok(burp);
232 amglue_export_ok(safe_overwrite_file);
240 open my $fh, "<", $file or croak "can't open $file: $!";
249 open my $fh, ">", $file or croak "can't open $file: $!";
253 sub safe_overwrite_file {
254 my ( $filename, $contents ) = @_;
256 my $tmpfname = "$filename." . time;
257 open my $tmpfh, ">", $tmpfname or die "open: $!";
259 print $tmpfh $contents;
260 (fsync($tmpfh) == 0) or die "fsync: $!";
261 return rename $tmpfname, $filename;
266 %typemap (in) GPtrArray * {
271 if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
272 SWIG_exception(SWIG_TypeError, "Expected an arrayref");
274 av = (AV *)SvRV($input);
276 len = av_len(av)+1; /* av_len(av) is like $#av */
277 $1 = g_ptr_array_sized_new(len);
278 for (i = 0; i < len; i++) {
279 SV **elt = av_fetch(av, i, 0);
280 if (!elt || !SvPOK(*elt)) {
281 SWIG_exception(SWIG_TypeError, "Non-string in arrayref");
283 g_ptr_array_add($1, SvPV_nolen(*elt)); /* TODO: handle unicode here */
286 %typemap (freearg) GPtrArray * {
287 g_ptr_array_free($1, FALSE);
290 %typemap (out) GPtrArray * {
293 for (i = 0; i < $1->len; i++) {
294 $result = sv_2mortal(newSVpv(g_ptr_array_index($1, i), 0));
297 g_ptr_array_free($1, TRUE);
299 $result = &PL_sv_undef;
304 /* for split_quoted_strings */
305 %typemap(out) gchar ** {
309 /* Count the DeviceProperties */
310 EXTEND(SP, g_strv_length($1)); /* make room for return values */
312 /* Note that we set $result several times. the nature of
313 * SWIG's wrapping is such that incrementing argvi points
314 * $result to the next location in perl's argument stack.
317 for (iter = $1; *iter; iter++) {
318 $result = sv_2mortal(newSVpv(*iter, 0));
326 %rename(hexencode) hexencode_string;
327 char *hexencode_string(char *);
328 %rename(hexdecode) perl_hexdecode_string;
329 char *perl_hexdecode_string(char *);
331 char *perl_hexdecode_string(const char *str) {
334 tmp = hexdecode_string(str, &err);
337 croak_gerror("Amanda util: hexdecode", &err);
342 amglue_export_tag(encoding, hexencode hexdecode);
344 %newobject sanitise_filename;
345 char *sanitise_filename(char *inp);
346 %newobject quote_string;
347 char *quote_string(char *);
348 %newobject unquote_string;
349 char *unquote_string(char *);
350 GPtrArray *expand_braced_alternates(char *);
351 %newobject collapse_braced_alternates;
352 char *collapse_braced_alternates(GPtrArray *source);
353 %newobject split_quoted_strings;
354 gchar **split_quoted_strings(const gchar *string);
355 amglue_export_tag(quoting, quote_string unquote_string skip_quoted_string
356 sanitise_filename split_quoted_strings split_quoted_strings_friendly);
357 amglue_export_tag(alternates, expand_braced_alternates collapse_braced_alternates);
361 sub generate_timestamp {
362 # this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
363 if (getconf($CNF_USETIMESTAMPS)) {
364 return strftime "%Y%m%d%H%M%S", localtime;
366 return strftime "%Y%m%d", localtime;
370 sub built_with_component {
371 my ($component) = @_;
372 my @components = split / +/, $Amanda::Constants::AMANDA_COMPONENTS;
373 return grep { $_ eq $component } @components;
378 /* interface to gnulib's fsusage */
379 %typemap(in,numinputs=0) (struct fs_usage *fsp)
380 (struct fs_usage fsu) {
381 bzero(&fsu, sizeof(fsu));
385 %typemap(argout) (struct fs_usage *fsp) {
389 /* if there was an error, assume that fsu_blocksize isn't changed,
390 * and return undef. */
391 if ($1->fsu_blocksize) {
392 SP += argvi; PUTBACK; /* save the perl stack so amglue_newSVi64 doesn't kill it */
393 hv = (HV *)sv_2mortal((SV *)newHV());
394 hv_store(hv, "blocksize", 9, amglue_newSVi64($1->fsu_blocksize), 0);
395 hv_store(hv, "blocks", 6, amglue_newSVi64($1->fsu_blocks), 0);
396 hv_store(hv, "bfree", 5, amglue_newSVi64($1->fsu_bfree), 0);
397 hv_store(hv, "bavail", 6, amglue_newSVi64($1->fsu_bavail), 0);
398 hv_store(hv, "bavail_top_bit_set", 18, newSViv($1->fsu_bavail_top_bit_set), 0);
399 hv_store(hv, "files", 5, amglue_newSVi64($1->fsu_files), 0);
400 hv_store(hv, "ffree", 5, amglue_newSVi64($1->fsu_ffree), 0);
402 $result = newRV((SV *)hv);
403 SPAGAIN; SP -= argvi;
408 %rename(get_fs_usage) get_fs_usage_;
410 void get_fs_usage_(const char *file, struct fs_usage *fsp)
412 int rv = get_fs_usage(file, NULL, fsp);
414 /* signal an error to the typemap */
415 fsp->fsu_blocksize = 0;
420 * Operations that should be in Perl but aren't
425 /* Perl's fcntl only operates on file handles */
428 set_blocking(int fd, gboolean blocking)
430 int flags = fcntl(fd, F_GETFL, 0);
434 flags &= ~O_NONBLOCK;
437 flags = fcntl(fd, F_SETFL, flags);
445 * Locking (see amflock.h)
448 /* SWIG prepends the struct name to the member function name, which
449 * conflicts with the underlying function names */
451 typedef struct file_lock {
453 %newobject file_lock;
454 file_lock(const char *filename) {
455 return file_lock_new(filename);
459 file_lock_free(self);
468 %typemap(in) (const char *data, size_t len) {
469 $1 = SvPV($input, $2);
472 int write(const char *data, size_t len);
474 /* get the data as an SV */
475 %typemap(out) (SV *) { $result = $1; argvi++; };
478 return newSVpvn(self->data, self->len);
483 %typemap(out) (SV *);
492 return 1 if $pid == $$;
494 my $Amanda_process = Amanda::Process->new(0);
496 $Amanda_process->load_ps_table();
497 my $alive = $Amanda_process->process_alive($pid);
503 /* Interesting story: Perl added a sv_rvweaken function in 5.6.0 (or earlier?), but
504 * did not include this functionality in Scalar::Util until later. It doesn't make
505 * much sense, does it? */
506 amglue_export_ok(weaken_ref)
507 %typemap(in) SV *rv "$1 = $input;"
509 void weaken_ref(SV *rv) {
514 %rename(gettimeofday) gettimeofday_for_perl;
516 static guint64 gettimeofday_for_perl(void)
519 g_get_current_time(&t);
520 return (guint64)t.tv_sec * G_USEC_PER_SEC + (guint64)t.tv_usec;
524 void openbsd_fd_inform(void);
529 * TODO: this should move to Amanda::Security when the rest of the Security API
530 * is available from Perl.
534 enum { STREAM_BUFSIZE };
535 %typemap(in, numinputs=0) in_port_t *port_ARGOUT (in_port_t port) {
538 %typemap(argout) in_port_t *port_ARGOUT {
539 $result = sv_2mortal(newSViv(*$1));
542 /* avoid BigInts for socket fd's */
543 %{ typedef int socketfd; %}
544 %typemap(out) socketfd {
545 $result = sv_2mortal(newSViv($1));
548 socketfd stream_server(int family, in_port_t *port_ARGOUT, size_t sendsize,
549 size_t recvsize, gboolean privileged);
551 socketfd stream_accept(int fd, int timeout, size_t sendsize, size_t recvsize);
553 %newobject check_security_fd;
554 %rename(check_security) check_security_fd;
556 char *check_security_fd(int fd, char *userstr)
559 struct sockaddr_in addr;
562 /* get the remote address */
564 if (getpeername(fd, (struct sockaddr *)&addr, &i) == -1) {
565 return g_strdup_printf("getpeername: %s", strerror(errno));
568 /* require IPv4 and not port 20 -- apparently this was a common attack
569 * vector for much older Amandas */
570 if ((addr.sin_family != (sa_family_t)AF_INET)
571 || (ntohs(addr.sin_port) == 20)) {
572 return g_strdup_printf("connection rejected from %s family %d port %d",
573 inet_ntoa(addr.sin_addr), addr.sin_family, htons(addr.sin_port));
576 /* call out to check_security */
577 if (!check_security((sockaddr_union *)&addr, userstr, 0, &errstr))
584 stream_server stream_accept check_security);
585 amglue_export_tag(constants,
586 $AF_INET $STREAM_BUFSIZE);
590 # these functions were verified to work similarly to those in
591 # common-src/tapelist.c - they pass the same tests, at least.
593 sub marshal_tapespec {
595 my @filelist = @$filelist; # make a copy we can wreck
599 my $label = shift @filelist;
600 my $files = shift @filelist;
602 $label =~ s/([\\:;,])/\\$1/g;
603 push @specs, "$label:" . join(",", @$files);
605 return join(";", @specs);
608 sub unmarshal_tapespec {
612 # detect a non-tapespec string for special handling; in particular, a string
613 # without an unquoted : followed by digits and commas at the end. The easiest
614 # way to do this is to replace every quoted character with a dummy, then look
615 # for the colon and digits.
617 $tmp =~ s/\\([\\:;,])/X/g;
618 if ($tmp !~ /:[,\d]+$/) {
619 # ok, it doesn't end with the right form, so unquote it and return it
621 $tapespec =~ s/\\([\\:;,])/$1/g;
622 return [ $tapespec, [ 0 ] ];
625 # use a lookbehind to mask out any quoted ;'s
626 my @volumes = split(/(?<!\\);/, $tapespec);
627 for my $vol (@volumes) {
628 my ($label, $files) = ($vol =~ /(.+):([\d,]+)/);
630 $label =~ s/\\([\\:;,])/$1/g;
631 push @filelist, $label;
633 my @files = split(/,/, $files);
634 @files = map { $_+0 } @files;
635 @files = sort { $a <=> $b } @files;
636 push @filelist, \@files;
645 match_host match_disk match_datestamp match_level
648 gboolean match_host(char *pat, char *value);
649 gboolean match_disk(char *pat, char *value);
650 gboolean match_datestamp(char *pat, char *value);
651 gboolean match_level(char *pat, char *value);
654 /* -------------------------------------------------------------------------
655 * Functions below this line are only meant to be called within this module;
656 * do not call them externally. */
658 void set_pname(char *name);
660 void set_ptype(char *type);
662 void set_pcontext(pcontext_t context);
663 pcontext_t get_pcontext();
666 void check_running_as(running_as_flags who);
668 /* Check that fd's 0, 1, and 2 are open, calling critical() if not.
672 fcntl(STDIN, F_GETFD, 0) or critical("Standard input is not open");
673 fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open");
674 fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");