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

   1 # This file was automatically generated by SWIG (http://www.swig.org).
   2 # Version 1.3.39
   3 #
   4 # Do not make changes to this file unless you know what you are doing--modify
   5 # the SWIG interface file instead.
   6
   7 package Amanda::Util;
   8 use base qw(Exporter);
   9 use base qw(DynaLoader);
  10 package Amanda::Utilc;
  11 bootstrap Amanda::Util;
  12 package Amanda::Util;
  13 @EXPORT = qw();
  14
  15 # ---------- BASE METHODS -------------
  16
  17 package Amanda::Util;
  18
  19 sub TIEHASH {
  20     my ($classname,$obj) = @_;
  21     return bless $obj, $classname;
  22 }
  23
  24 sub CLEAR { }
  25
  26 sub FIRSTKEY { }
  27
  28 sub NEXTKEY { }
  29
  30 sub FETCH {
  31     my ($self,$field) = @_;
  32     my $member_func = "swig_${field}_get";
  33     $self->$member_func();
  34 }
  35
  36 sub STORE {
  37     my ($self,$field,$newval) = @_;
  38     my $member_func = "swig_${field}_set";
  39     $self->$member_func($newval);
  40 }
  41
  42 sub this {
  43     my $ptr = shift;
  44     return tied(%$ptr);
  45 }
  46
  47
  48 # ------- FUNCTION WRAPPERS --------
  49
  50 package Amanda::Util;
  51
  52 *get_original_cwd = *Amanda::Utilc::get_original_cwd;
  53 *sanitise_filename = *Amanda::Utilc::sanitise_filename;
  54 *quote_string = *Amanda::Utilc::quote_string;
  55 *unquote_string = *Amanda::Utilc::unquote_string;
  56 *set_pname = *Amanda::Utilc::set_pname;
  57 *set_ptype = *Amanda::Utilc::set_ptype;
  58 *set_pcontext = *Amanda::Utilc::set_pcontext;
  59 *safe_cd = *Amanda::Utilc::safe_cd;
  60 *check_running_as = *Amanda::Utilc::check_running_as;
  61
  62 # ------- VARIABLE STUBS --------
  63
  64 package Amanda::Util;
  65
  66 *RUNNING_AS_ANY = *Amanda::Utilc::RUNNING_AS_ANY;
  67 *RUNNING_AS_ROOT = *Amanda::Utilc::RUNNING_AS_ROOT;
  68 *RUNNING_AS_DUMPUSER = *Amanda::Utilc::RUNNING_AS_DUMPUSER;
  69 *RUNNING_AS_DUMPUSER_PREFERRED = *Amanda::Utilc::RUNNING_AS_DUMPUSER_PREFERRED;
  70 *RUNNING_AS_CLIENT_LOGIN = *Amanda::Utilc::RUNNING_AS_CLIENT_LOGIN;
  71 *RUNNING_AS_UID_ONLY = *Amanda::Utilc::RUNNING_AS_UID_ONLY;
  72 *CONTEXT_DEFAULT = *Amanda::Utilc::CONTEXT_DEFAULT;
  73 *CONTEXT_CMDLINE = *Amanda::Utilc::CONTEXT_CMDLINE;
  74 *CONTEXT_DAEMON = *Amanda::Utilc::CONTEXT_DAEMON;
  75 *CONTEXT_SCRIPTUTIL = *Amanda::Utilc::CONTEXT_SCRIPTUTIL;
  76
  77 @EXPORT_OK = ();
  78 %EXPORT_TAGS = ();
  79
  80 use Amanda::Debug qw(:init);
  81 use Amanda::Config qw(:getconf);
  82 use Carp;
  83 use POSIX qw( :fcntl_h strftime );
  84
  85 =head1 NAME
  86
  87 Amanda::Util - Runtime support for Amanda applications
  88
  89 =head1 Application Initialization
  90
  91 Application initialization generally looks like this:
  92
  93   use Amanda::Config qw( :init );
  94   use Amanda::Util qw( :constants );
  95   use Amanda::Debug;
  96
  97   Amanda::Util::setup_application("myapp", "server", $CONTEXT_CMDLINE);
  98   # .. command-line processing ..
  99   Amanda::Config::config_init(...);
 100   Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 101
 102 =over
 103
 104 =item C<setup_application($name, $type, $context)>
 105
 106 Set up the operating environment for an application, without requiring any
 107 configuration.
 108
 109 C<$name> is the name of the application, used in log messages, etc.  C<$type>
 110 is usualy one of "server" or "client".  It specifies the subdirectory in which
 111 debug logfiles will be created.  C<$context> indicates the usual manner in
 112 which this application is invoked; one of C<$CONTEXT_CMDLINE> for a
 113 user-invoked command-line utility (e.g., C<amadmin>) which should send
 114 human-readable error messages to stderr; C<$CONTEXT_DAEMON> for a program
 115 started by C<amandad>, e.g., C<sendbackup>; or C<$CONTEXT_SCRIPTUTIL> for a
 116 small program used from shell scripts, e.g., C<amgetconf>
 117
 118 Based on C<$type> and C<$context>, this function does the following:
 119
 120 =over
 121
 122 =item *
 123
 124 sets up debug logging;
 125
 126 =item *
 127
 128 configures internationalization
 129
 130 =item *
 131
 132 sets the umask;
 133
 134 =item *
 135
 136 sets the current working directory to the debug or temporary directory;
 137
 138 =item *
 139
 140 closes any unnecessary file descriptors as a security meaasure;
 141
 142 =item *
 143
 144 ignores C<SIGPIPE>; and
 145
 146 =item *
 147
 148 sets the appropriate target for error messages.
 149
 150 =back
 151
 152 =cut
 153
 154 # private package variables
 155 my $_pname;
 156 my $_ptype;
 157 my $_pcontext;
 158
 159 sub setup_application {
 160     my ($name, $type, $context) = @_;
 161
 162     # sanity check
 163     croak("no name given") unless ($name);
 164     croak("no type given") unless ($type);
 165     croak("no context given") unless ($context);
 166
 167     # store these as perl values
 168     $_pname = $name;
 169     $_ptype = $type;
 170     $_pcontext = $context;
 171
 172     # and let the C side know about them too
 173     set_pname($name);
 174     set_ptype($type);
 175     set_pcontext($context);
 176
 177     safe_cd(); # (also sets umask)
 178     check_std_fds();
 179
 180     # set up debugging, now that we have a name, type, and context
 181     debug_init();
 182
 183     # ignore SIGPIPE
 184     $SIG{'PIPE'} = 'IGNORE';
 185 }
 186
 187 =item C<finish_setup($running_as_flags)>
 188
 189 Perform final initialization tasks that require a loaded configuration.
 190 Specifically, move the debug log into a configuration-specific
 191 subdirectory, and check that the current userid is appropriate for
 192 this applciation.
 193
 194 The user is specified by one of the following flags, which are
 195 available in export tag C<:check_running_as_flags>:
 196
 197   $RUNNING_AS_ANY                 # any user is OK
 198   $RUNNING_AS_ROOT                # root
 199   $RUNNING_AS_DUMPUSER            # dumpuser, from configuration
 200   $RUNNING_AS_DUMPUSER_PREFERRED  # dumpuser, but client_login is OK too
 201   $RUNNING_AS_CLIENT_LOGIN        # client_login (--with-user at build time)
 202
 203 If the flag C<$RUNNING_AS_UID_ONLY> is bit-or'd into C<$running_as_flags>, then
 204 the euid is ignored; this is used for programs that expect to be setuid-root.
 205
 206 =cut
 207
 208 sub finish_setup {
 209     my ($running_as) = @_;
 210
 211     my $config_name = Amanda::Config::get_config_name();
 212
 213     if ($config_name) {
 214         dbrename($config_name, $_ptype);
 215     }
 216
 217     check_running_as($running_as);
 218 }
 219
 220 =item C<get_original_cwd()>
 221
 222 Return the original current directory with C<get_original_cwd>.
 223
 224 =cut
 225
 226 push @EXPORT_OK, qw(get_original_cwd);
 227 push @{$EXPORT_TAGS{"util"}}, qw(get_original_cwd);
 228
 229 =head1 Miscellaneous Utilities
 230
 231 =item C<safe_env()>
 232
 233 Return a "safe" environment hash.  For non-setuid programs, this means filtering out any
 234 localization variables.
 235
 236 =cut
 237
 238 sub safe_env {
 239     my %rv = %ENV;
 240
 241     delete @rv{qw(IFS CDPATH ENV BASH_ENV LANG)};
 242
 243     # delete all LC_* variables
 244     for my $var (grep /^LC_/, keys %rv) {
 245         delete $rv{$var};
 246     }
 247
 248     return %rv;
 249 }
 250
 251
 252 push @EXPORT_OK, qw(running_as_flags_to_strings);
 253 push @{$EXPORT_TAGS{"running_as_flags"}}, qw(running_as_flags_to_strings);
 254
 255 my %_running_as_flags_VALUES;
 256 #Convert a flag value to a list of names for flags that are set.
 257 sub running_as_flags_to_strings {
 258     my ($flags) = @_;
 259     my @result = ();
 260
 261     for my $k (keys %_running_as_flags_VALUES) {
 262         my $v = $_running_as_flags_VALUES{$k};
 263
 264         #is this a matching flag?
 265         if (($v == 0 && $flags == 0) || ($v != 0 && ($flags & $v) == $v)) {
 266             push @result, $k;
 267         }
 268     }
 269
 270 #by default, just return the number as a 1-element list
 271     if (!@result) {
 272         return ($flags);
 273     }
 274
 275     return @result;
 276 }
 277
 278 push @EXPORT_OK, qw($RUNNING_AS_ANY);
 279 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_ANY);
 280
 281 $_running_as_flags_VALUES{"RUNNING_AS_ANY"} = $RUNNING_AS_ANY;
 282
 283 push @EXPORT_OK, qw($RUNNING_AS_ROOT);
 284 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_ROOT);
 285
 286 $_running_as_flags_VALUES{"RUNNING_AS_ROOT"} = $RUNNING_AS_ROOT;
 287
 288 push @EXPORT_OK, qw($RUNNING_AS_DUMPUSER);
 289 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_DUMPUSER);
 290
 291 $_running_as_flags_VALUES{"RUNNING_AS_DUMPUSER"} = $RUNNING_AS_DUMPUSER;
 292
 293 push @EXPORT_OK, qw($RUNNING_AS_DUMPUSER_PREFERRED);
 294 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_DUMPUSER_PREFERRED);
 295
 296 $_running_as_flags_VALUES{"RUNNING_AS_DUMPUSER_PREFERRED"} = $RUNNING_AS_DUMPUSER_PREFERRED;
 297
 298 push @EXPORT_OK, qw($RUNNING_AS_CLIENT_LOGIN);
 299 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_CLIENT_LOGIN);
 300
 301 $_running_as_flags_VALUES{"RUNNING_AS_CLIENT_LOGIN"} = $RUNNING_AS_CLIENT_LOGIN;
 302
 303 push @EXPORT_OK, qw($RUNNING_AS_UID_ONLY);
 304 push @{$EXPORT_TAGS{"running_as_flags"}}, qw($RUNNING_AS_UID_ONLY);
 305
 306 $_running_as_flags_VALUES{"RUNNING_AS_UID_ONLY"} = $RUNNING_AS_UID_ONLY;
 307
 308 #copy symbols in running_as_flags to constants
 309 push @{$EXPORT_TAGS{"constants"}},  @{$EXPORT_TAGS{"running_as_flags"}};
 310
 311 push @EXPORT_OK, qw(pcontext_t_to_string);
 312 push @{$EXPORT_TAGS{"pcontext_t"}}, qw(pcontext_t_to_string);
 313
 314 my %_pcontext_t_VALUES;
 315 #Convert an enum value to a single string
 316 sub pcontext_t_to_string {
 317     my ($enumval) = @_;
 318
 319     for my $k (keys %_pcontext_t_VALUES) {
 320         my $v = $_pcontext_t_VALUES{$k};
 321
 322         #is this a matching flag?
 323         if ($enumval == $v) {
 324             return $k;
 325         }
 326     }
 327
 328 #default, just return the number
 329     return $enumval;
 330 }
 331
 332 push @EXPORT_OK, qw($CONTEXT_DEFAULT);
 333 push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_DEFAULT);
 334
 335 $_pcontext_t_VALUES{"CONTEXT_DEFAULT"} = $CONTEXT_DEFAULT;
 336
 337 push @EXPORT_OK, qw($CONTEXT_CMDLINE);
 338 push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_CMDLINE);
 339
 340 $_pcontext_t_VALUES{"CONTEXT_CMDLINE"} = $CONTEXT_CMDLINE;
 341
 342 push @EXPORT_OK, qw($CONTEXT_DAEMON);
 343 push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_DAEMON);
 344
 345 $_pcontext_t_VALUES{"CONTEXT_DAEMON"} = $CONTEXT_DAEMON;
 346
 347 push @EXPORT_OK, qw($CONTEXT_SCRIPTUTIL);
 348 push @{$EXPORT_TAGS{"pcontext_t"}}, qw($CONTEXT_SCRIPTUTIL);
 349
 350 $_pcontext_t_VALUES{"CONTEXT_SCRIPTUTIL"} = $CONTEXT_SCRIPTUTIL;
 351
 352 #copy symbols in pcontext_t to constants
 353 push @{$EXPORT_TAGS{"constants"}},  @{$EXPORT_TAGS{"pcontext_t"}};
 354
 355 =item C<quote_string($str)>
 356
 357 Quote a string using Amanda's quoting algorithm.  Strings with no whitespace,
 358 control, or quote characters are returned unchanged.  An empty string is
 359 represented as the two-character string C<"">.  Otherwise, tab, newline,
 360 carriage return, form-feed, backslash, and double-quote (C<">) characters are
 361 escaped with a backslash and the string is surrounded by double quotes.
 362
 363 =item C<unquote_string($str)>
 364
 365 Unquote a string as quoted with C<quote_string>.
 366
 367 =item C<skip_quoted_string($str)>
 368
 369 my($q, $remaider) = skip_quoted_string($str)
 370
 371 Return the first quoted string and the remainder of the string.
 372
 373 Both C<quote_string>, C<unquote_string> and C<skip_quoted_string> are
 374 available under the export tag C<:quoting>.
 375
 376 =cut
 377
 378 sub skip_quoted_string {
 379     my $str = shift;
 380
 381     chomp $str;
 382     my $iq = 0;
 383     my $i = 0;
 384     my $c = substr $str, $i, 1;
 385     while ($c ne "" && !($iq == 0 && $c =~ /\s/)) {
 386         if ($c eq '"') {
 387             $iq = !$iq;
 388         } elsif ($c eq '\\') {
 389             $i++;
 390         }
 391         $i++;
 392         $c = substr $str, $i, 1;
 393     }
 394     my $quoted_string = substr $str, 0, $i;
 395     my $remainder     = substr $str, $i+1;
 396
 397     return ($quoted_string, $remainder);
 398 }
 399
 400
 401 push @EXPORT_OK, qw(quote_string unquote_string skip_quoted_string sanitise_filename);
 402 push @{$EXPORT_TAGS{"quoting"}}, qw(quote_string unquote_string skip_quoted_string sanitise_filename);
 403
 404 =item C<generate_timestamp()>
 405
 406 Generate a timestamp from the current time, obeying the 'USETIMESTAMPS'
 407 config parameter.  The Amanda configuration must already be loaded.
 408
 409 =cut
 410
 411 sub generate_timestamp {
 412     # this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
 413     if (getconf($CNF_USETIMESTAMPS)) {
 414         return strftime "%Y%m%d%H%M%S", localtime;
 415     } else {
 416         return strftime "%Y%m%d", localtime;
 417     }
 418 }
 419
 420 sub check_std_fds {
 421     fcntl(STDIN, F_GETFD, 0) or critical("Standard input is not open");
 422     fcntl(STDOUT, F_GETFD, 0) or critical("Standard output is not open");
 423     fcntl(STDERR, F_GETFD, 0) or critical("Standard error is not open");
 424 }
 425
 426 =back
 427
 428 =cut
 429 1;