debian/scripts/koha-shell

   1 #!/usr/bin/perl
   2 # koha-shell -- put you in a shell with a koha environment set up
   3 # Copyright 2012  Catalyst IT, Ltd
   4 #
   5 # This program is free software: you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 use Getopt::Long;
  19 use Modern::Perl;
  20
  21 Getopt::Long::Configure("bundling");
  22
  23 my $pwd = `pwd`;
  24 my %opts;
  25 my $res = GetOptions( \%opts, "command|c=s", "help|h", "login|l", "shell|s=s",
  26     "preserve-environment|p|m", "verbose|v" );
  27
  28 if ( !$res || $opts{help} ) {
  29     show_help( !$res );
  30     exit( !$res );
  31 }
  32
  33 if ( !@ARGV ) {
  34     show_help( 1, "An instance name must be supplied." );
  35     exit(1);
  36 }
  37 my $instance = shift @ARGV;
  38 if ( !-e "/etc/koha/sites/$instance" ) {
  39     show_help( 1, "The instance doesn't exist: $instance" );
  40     exit(1);
  41 }
  42 my $shell = $opts{shell} || $ENV{SHELL} || '/bin/sh';
  43
  44 # Now we're set up, build the 'su' command
  45 my $perl5lib = read_perl5lib( $instance );
  46 my @su_args;
  47 push @su_args, '/usr/bin/sudo';
  48 push @su_args, '--preserve-env' if $opts{'preserve-environment'};
  49 push @su_args, '--login' if $opts{login} || !$opts{command};
  50 push @su_args, "-u", "$instance-koha";
  51 push @su_args,
  52     "env "
  53   . "KOHA_CONF=/etc/koha/sites/$instance/koha-conf.xml "
  54   . "PERL5LIB=$perl5lib $shell"
  55   . ( $opts{command} ? " -c '$opts{command}'" : " -c 'cd \"$pwd\"; $shell'" );
  56
  57 print "Command: '".join("' '",@su_args)."'\n" if $opts{verbose};
  58 system("@su_args");
  59 if ( $? == -1 ) {
  60     print STDERR "failed to execute: $!\n";
  61 }
  62 elsif ( $? & 127 ) {
  63     printf STDERR "child died with signal %d, %s coredump\n",
  64       ( $? & 127 ), ( $? & 128 ) ? 'with' : 'without';
  65 }
  66
  67 exit $? >> 8;
  68
  69 sub show_help {
  70     my ( $err, $msg ) = @_;
  71
  72     my $fh = $err ? *STDERR : *STDOUT;
  73     say $fh "Error: " . $msg if $msg;
  74     print $fh $_ while <DATA>;
  75 }
  76
  77 sub read_perl5lib {
  78     my ( $instance ) = @_;
  79
  80     # This simulates what the debian shell scripts do:
  81     # Read /etc/default/koha-common
  82     # Check dev_install in koha-conf.xml
  83
  84     my $result = `grep "^PERL5LIB=" /etc/default/koha-common`;
  85     chomp $result;
  86     $result =~ s/^PERL5LIB=\s*//;
  87     my $dev_install = `xmlstarlet sel -t -v 'yazgfs/config/dev_install' /etc/koha/sites/$instance/koha-conf.xml`;
  88     chomp $dev_install;
  89     if ( $dev_install ) {
  90         # pick PERL5LIB from the intranetdir entry
  91         $result = `xmlstarlet sel -t -v "yazgfs/config/intranetdir" /etc/koha/sites/$instance/koha-conf.xml`;
  92         $result = "$result:$result/lib";
  93     }
  94     return $result;
  95 }
  96
  97 __DATA__
  98 koha-shell -- gives you a shell with your Koha environment set up
  99
 100 Usage: koha-shell [options] [instance name]
 101
 102 Options:
 103     -c, --command COMMAND   pass COMMAND to the invoked shell
 104     -h, --help              show this help and quit
 105     -l, --login             make the shell a login shell
 106     -m, -p,
 107     --preserve-environment  do not reset environment variables
 108     -s, --shell SHELL       use SHELL instead of the one from your environment
 109     -v, --verbose           output the full command that will be executed
 110
 111 The default shell is the one currently in use. Refer to su(1) for more detail
 112 on these options.