git.gag.com Git - debian/amanda/blob - perl/Amanda/Util.swg

   1 /*
   2  * Copyright (c) Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This library is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU Lesser General Public License version 2.1
   6  * as published by the Free Software Foundation.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  11  * License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public License
  14  * along with this library; if not, write to the Free Software Foundation,
  15  * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
  16  *
  17  * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  18  * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19  */
  20
  21 %module "Amanda::Util"
  22 %include "amglue/amglue.swg"
  23 %include "exception.i"
  24
  25 %{
  26 #include "debug.h"
  27 /* use a relative path here to avoid conflicting with Perl's util.h. */
  28 #include "../common-src/util.h"
  29 #include "file.h"
  30 %}
  31
  32 %perlcode %{
  33 use Amanda::Debug qw(:init);
  34 use Amanda::Config qw(:getconf);
  35 use Carp;
  36 use POSIX qw( :fcntl_h strftime );
  37
  38 =head1 NAME
  39
  40 Amanda::Util - Runtime support for Amanda applications
  41
  42 =head1 Application Initialization
  43
  44 Application initialization generally looks like this:
  45
  46   use Amanda::Config qw( :init );
  47   use Amanda::Util qw( :constants );
  48   use Amanda::Debug;
  49
  50   Amanda::Util::setup_application("myapp", "server", $CONTEXT_CMDLINE);
  51   # .. command-line processing ..
  52   Amanda::Config::config_init(...);
  53   Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
  54
  55 =over
  56
  57 =item C<setup_application($name, $type, $context)>
  58
  59 Set up the operating environment for an application, without requiring any
  60 configuration.
  61
  62 C<$name> is the name of the application, used in log messages, etc.  C<$type>
  63 is usualy one of "server" or "client".  It specifies the subdirectory in which
  64 debug logfiles will be created.  C<$context> indicates the usual manner in
  65 which this application is invoked; one of C<$CONTEXT_CMDLINE> for a
  66 user-invoked command-line utility (e.g., C<amadmin>) which should send
  67 human-readable error messages to stderr; C<$CONTEXT_DAEMON> for a program
  68 started by C<amandad>, e.g., C<sendbackup>; or C<$CONTEXT_SCRIPTUTIL> for a
  69 small program used from shell scripts, e.g., C<amgetconf>
  70
  71 Based on C<$type> and C<$context>, this function does the following:
  72
  73 =over
  74
  75 =item *
  76
  77 sets up debug logging;
  78
  79 =item *
  80
  81 configures internationalization
  82
  83 =item *
  84
  85 sets the umask;
  86
  87 =item *
  88
  89 sets the current working directory to the debug or temporary directory;
  90
  91 =item *
  92
  93 closes any unnecessary file descriptors as a security meaasure;
  94
  95 =item *
  96
  97 ignores C<SIGPIPE>; and
  98
  99 =item *
 100
 101 sets the appropriate target for error messages.
 102
 103 =back
 104
 105 =cut
 106
 107 # private package variables
 108 my $_pname;
 109 my $_ptype;
 110 my $_pcontext;
 111
 112 sub setup_application {
 113     my ($name, $type, $context) = @_;
 114
 115     # sanity check
 116     croak("no name given") unless ($name);
 117     croak("no type given") unless ($type);
 118     croak("no context given") unless ($context);
 119
 120     # store these as perl values
 121     $_pname = $name;
 122     $_ptype = $type;
 123     $_pcontext = $context;
 124
 125     # and let the C side know about them too
 126     set_pname($name);
 127     set_ptype($type);
 128     set_pcontext($context);
 129
 130     safe_cd(); # (also sets umask)
 131     check_std_fds();
 132
 133     # set up debugging, now that we have a name, type, and context
 134     debug_init();
 135
 136     # ignore SIGPIPE
 137     $SIG{'PIPE'} = 'IGNORE';
 138 }
 139
 140 =item C<finish_setup($running_as_flags)>
 141
 142 Perform final initialization tasks that require a loaded configuration.
 143 Specifically, move the debug log into a configuration-specific
 144 subdirectory, and check that the current userid is appropriate for
 145 this applciation.
 146
 147 The user is specified by one of the following flags, which are
 148 available in export tag C<:check_running_as_flags>:
 149
 150   $RUNNING_AS_ANY                 # any user is OK
 151   $RUNNING_AS_ROOT                # root
 152   $RUNNING_AS_DUMPUSER            # dumpuser, from configuration
 153   $RUNNING_AS_DUMPUSER_PREFERRED  # dumpuser, but client_login is OK too
 154   $RUNNING_AS_CLIENT_LOGIN        # client_login (--with-user at build time)
 155
 156 If the flag C<$RUNNING_AS_UID_ONLY> is bit-or'd into C<$running_as_flags>, then
 157 the euid is ignored; this is used for programs that expect to be setuid-root.
 158
 159 =cut
 160
 161 sub finish_setup {
 162     my ($running_as) = @_;
 163
 164     my $config_name = Amanda::Config::get_config_name();
 165
 166     if ($config_name) {
 167         dbrename($config_name, $_ptype);
 168     }
 169
 170     check_running_as($running_as);
 171 }
 172
 173 =item C<get_original_cwd()>
 174
 175 Return the original current directory with C<get_original_cwd>.
 176
 177 =cut
 178 %}
 179 char *get_original_cwd(void);
 180 amglue_export_tag(util, get_original_cwd);
 181
 182 %perlcode %{
 183 =head1 Miscellaneous Utilities
 184
 185 =item C<safe_env()>
 186
 187 Return a "safe" environment hash.  For non-setuid programs, this means filtering out any
 188 localization variables.
 189
 190 =cut
 191
 192 sub safe_env {
 193     my %rv = %ENV;
 194
 195     delete @rv{qw(IFS CDPATH ENV BASH_ENV LANG)};
 196
 197     # delete all LC_* variables
 198     for my $var (grep /^LC_/, keys %rv) {
 199         delete $rv{$var};
 200     }
 201
 202     return %rv;
 203 }
 204
 205 %}
 206
 207 amglue_add_flag_tag_fns(running_as_flags);
 208 amglue_add_constant(RUNNING_AS_ANY, running_as_flags);
 209 amglue_add_constant(RUNNING_AS_ROOT, running_as_flags);
 210 amglue_add_constant(RUNNING_AS_DUMPUSER, running_as_flags);
 211 amglue_add_constant(RUNNING_AS_DUMPUSER_PREFERRED, running_as_flags);
 212 amglue_add_constant(RUNNING_AS_CLIENT_LOGIN, running_as_flags);
 213 amglue_add_constant(RUNNING_AS_UID_ONLY, running_as_flags);
 214 amglue_copy_to_tag(running_as_flags, constants);
 215
 216 amglue_add_enum_tag_fns(pcontext_t);
 217 amglue_add_constant(CONTEXT_DEFAULT, pcontext_t);
 218 amglue_add_constant(CONTEXT_CMDLINE, pcontext_t);
 219 amglue_add_constant(CONTEXT_DAEMON, pcontext_t);
 220 amglue_add_constant(CONTEXT_SCRIPTUTIL, pcontext_t);
 221 amglue_copy_to_tag(pcontext_t, constants);
 222
 223 %perlcode %{
 224 =item C<quote_string($str)>
 225
 226 Quote a string using Amanda's quoting algorithm.  Strings with no whitespace,
 227 control, or quote characters are returned unchanged.  An empty string is
 228 represented as the two-character string C<"">.  Otherwise, tab, newline,
 229 carriage return, form-feed, backslash, and double-quote (C<">) characters are
 230 escaped with a backslash and the string is surrounded by double quotes.
 231
 232 =item C<unquote_string($str)>
 233
 234 Unquote a string as quoted with C<quote_string>.
 235
 236 =item C<skip_quoted_string($str)>
 237
 238 my($q, $remaider) = skip_quoted_string($str)
 239
 240 Return the first quoted string and the remainder of the string.
 241
 242 Both C<quote_string>, C<unquote_string> and C<skip_quoted_string> are
 243 available under the export tag C<:quoting>.
 244
 245 =cut
 246
 247 sub skip_quoted_string {
 248     my $str = shift;
 249
 250     chomp $str;
 251     my $iq = 0;
 252     my $i = 0;
 253     my $c = substr $str, $i, 1;
 254     while ($c ne "" && !($iq == 0 && $c =~ /\s/)) {
 255         if ($c eq '"') {
 256             $iq = !$iq;
 257         } elsif ($c eq '\\') {
 258             $i++;
 259         }
 260         $i++;
 261         $c = substr $str, $i, 1;
 262     }
 263     my $quoted_string = substr $str, 0, $i;
 264     my $remainder     = substr $str, $i+1;
 265
 266     return ($quoted_string, $remainder);
 267 }
 268
 269 %}
 270
 271 char *sanitise_filename(char *inp);
 272 char *quote_string(char *);
 273 char *unquote_string(char *);
 274 amglue_export_tag(quoting, quote_string unquote_string skip_quoted_string sanitise_filename);
 275
 276 %perlcode %{
 277 =item C<generate_timestamp()>
 278
 279 Generate a timestamp from the current time, obeying the 'USETIMESTAMPS'
 280 config parameter.  The Amanda configuration must already be loaded.
 281
 282 =cut
 283
 284 sub generate_timestamp {
 285     # this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
 286     if (getconf($CNF_USETIMESTAMPS)) {
 287         return strftime "%Y%m%d%H%M%S", localtime;
 288     } else {
 289         return strftime "%Y%m%d", localtime;
 290     }
 291 }
 292 %}
 293
 294 /* -------------------------------------------------------------------------
 295  * Functions below this line are only meant to be called within this module;
 296  * do not call them externally. */
 297
 298 void set_pname(char *name);
 299 void set_ptype(char *type);
 300 void set_pcontext(pcontext_t context);
 301 void safe_cd(void);
 302
 303 void check_running_as(running_as_flags who);
 304
 305 /* Check that fd's 0, 1, and 2 are open, calling critical() if not.
 306  */
 307 %perlcode %{
 308 sub check_std_fds {
 309     fcntl(STDIN, F_GETFD, 0) or critical("Standard input is not open");
 310     fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open");
 311     fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");
 312 }
 313
 314 =back
 315
 316 =cut
 317 %}