fusiondirectory-webservice-shell 1.0.8.2-5+deb8u1 / usr / bin / fusiondirectory-shell

#!/usr/bin/perl

#
# fusiondirectory-shell: A shell to act on FusionDirectory handled objects
# See pod documentation at the end of the file
#

use strict;
use warnings;

use 5.008;

use Getopt::Long;
use Pod::Usage;
use JSON::RPC::Client;
use Data::Dumper;
use Term::ShellUI;

my $host      = 'https://localhost/fusiondirectory/jsonrpc.php';
my $help      = 0;
my $ca_file   = 0;
my $login;
my $password;
my $ldap_server = undef;

# Process command-line

GetOptions(
  'help|?'      => \$help,
  'url=s'       => \$host,
  'ca=s'        => \$ca_file,
  'login=s'     => \$login,
  'password=s'  => \$password,
  'server=s'    => \$ldap_server
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(2) if not defined $login;
pod2usage(2) if not defined $password;

my $current_base;

sub rpc_init {
  my $client = JSON::RPC::Client->new();
  $client->version('1.0');
  if ($client->ua->can('ssl_opts')) {
    if ($ca_file) {
      $client->ua->ssl_opts(verify_hostname => 1, SSL_ca_file => "$ca_file");
    } else {
      $client->ua->ssl_opts(verify_hostname => 0);
    }
  }

  return $client;
}

sub rpc_call {
  my ($client, $action, $params) = @_;

  if (!$params) {
    $params = [];
  }

  my $callobj = {
    method  => $action,
    params  => $params,
  };

  #~ print Dumper($callobj);

  my $res = $client->call($host, $callobj);

  #~ print Dumper($res);

  if($res) {
    if ($res->is_error) {
      die "Error : ", $res->error_message."\n";
    }
    else {
      return $res->result;
    }
  }
  else {
    die "Status : ".$client->status_line."\n";
  }
}

use Term::ShellUI;
my $term = new Term::ShellUI(
  app => "fusiondirectory-shell",
  commands => {
    "help" => {
      desc    => "Print helpful information",
      args    => sub { shift->help_args(undef, @_); },
      method  => sub { shift->help_call(undef, @_); }
    },
    "h" => { alias => "help", exclude_from_completion=>1},
    "cd" => {
      desc    => "Change current base to BASE",
      maxargs => 1,
      proc    => \&command_cd,
    },
    "chdir" => { alias => 'cd' },
    "pwd" => {
      desc    => "Print the current working directory",
      maxargs => 0,
      proc    => sub { print $current_base."\n"; },
    },
    "ls" => {
      desc    => "List objects of a given type",
      minargs => 1,
      maxargs => 4,
      proc    => \&command_ls,
    },
    "count" => {
      desc    => "Count objects of a given type",
      minargs => 1,
      maxargs => 4,
      proc    => \&command_count,
    },
    "cat" => {
      desc    => "Show an object information",
      minargs => 1,
      maxargs => 3,
      proc    => \&command_cat,
    },
    "infos" => {
      desc    => "Show informations about a type",
      minargs => 1,
      maxargs => 1,
      proc    => \&command_infos,
    },
    "types" => {
      desc    => "List existing types",
      minargs => 0,
      maxargs => 0,
      proc    => \&command_types,
    },
    "exit" => {
      desc    => "Exit FusionDirectory shell",
      maxargs => 0,
      method  => sub { shift->exit_requested(1); },
    }
  },
  history_file => '~/.fusiondirectory_shell_history',
);

my $client  = rpc_init();
if (!defined $ldap_server) {
  my $ldaps = rpc_call($client, 'listLdaps');
  my @keys = keys(%$ldaps);
  if (scalar(@keys) == 0) {
    die "No LDAP server was returned by FusionDirectory\n";
  } elsif (scalar(@keys) == 1) {
    $ldap_server = $keys[0];
  } else {
    for (my $i = 0; $i < @keys; $i++) {
      my $key   = $keys[$i];
      my $label = $ldaps->{$key};
      print $i.":$label ($key)\n";
    }
    my $choice;
    do {
      $choice = $term->{term}->readline("Choice: ");
    } while (($choice eq '') || ($choice =~ m/[^0-9]/) || ($choice >= scalar(@keys)));
    $ldap_server = $keys[$choice];
  }
}
my $sid     = rpc_call($client, 'login', [$ldap_server, $login, $password]);
my $base    = rpc_call($client, 'getBase', [$sid]);

$current_base = $base;

print 'Using '.$term->{term}->ReadLine."\n";
$term->prompt(sub { $login.'@'.$current_base."> " });
$term->run();

sub command_ls
{
  my ($type, $attrs, $ou, $filter) = @_;
  if (! defined $ou) {
    $ou = $current_base;
  }
  if (! defined $filter) {
    $filter = '';
  }
  my $res = rpc_call($client, 'ls', [$sid,$type,$attrs,$ou,$filter]);
  if (ref $res eq ref {}) {
    while (my ($dn, $display) = each(%$res))
    {
      print "$display\t($dn)\n";
    }
  }
}

sub command_count
{
  my ($type, $ou, $filter) = @_;
  if (! defined $ou) {
    $ou = $current_base;
  }
  if (! defined $filter) {
    $filter = '';
  }
  my $res = rpc_call($client, 'count', [$sid,$type,$ou,$filter]);
  print "$res\n";
}

sub command_cd
{
  my ($path) = @_;
  if (! defined $path) {
    $path = $base;
  }
  if (!($path =~ m/$base$/)) {
    if (!($path =~ m/,$/)) {
      $path .= ',';
    }
    $path .= $current_base;
  }
  $current_base = $path;
}

sub command_cat
{
  my ($type, $path, $tab) = @_;
  if (defined $path) {
    if (!($path =~ m/$base$/)) {
      if (!($path =~ m/,$/)) {
        $path .= ',';
      }
      $path .= $current_base;
    }
  }
  my $fields = rpc_call($client, 'fields', [$sid,$type,$path,$tab]);
  if (ref $fields eq ref {}) {
    foreach my $section (values %$fields) {
      print '['.$section->{'name'}.']'."\n";
      if (ref $section->{'attrs'} eq ref []) {
        foreach my $field (@{$section->{'attrs'}}) {
          show_field($field);
        }
      }
    }
  }
}

sub show_field
{
  my ($field) = @_;
  foreach my $type (@{$field->{'type'}}) {
    if (grep {$type eq $_} ('StringAttribute', 'DisplayAttribute')) {
      printf ("\t%-22s %s\n", $field->{'label'}.':', $field->{'value'});
      return;
    }
  }
  # Default display
  if (ref($field->{'value'}) ne 'ARRAY') {
    printf ("\t%-22s %s\n", $field->{'label'}.':', $field->{'value'});
  } else {
    printf ("\t%-22s %s", $field->{'label'}.':', Dumper($field->{'value'}));
  }
}

sub ask_field
{
  my ($field) = @_;
  foreach my $type (@{$field->{'type'}}) {
    if (grep {$type eq $_} ('StringAttribute', 'IntAttribute')) {
      return $term->{term}->readline($field->{'label'}.": ");
    } elsif ($type eq 'SelectAttribute') {
      print $field->{'label'}.":\n";
      my $i = 0;
      my @keys = keys(%{$field->{'choices'}});
      if (scalar(@keys) eq 0) {
        return '';
      }
      for ($i = 0; $i < @keys; $i++) {
        my $key   = $keys[$i];
        my $label = ${$field->{'choices'}}{$key};
        print $i.":$label ($key)\n";
        #~ if ($id eq $field->{'value'}) {
      }
      my $choice;
      do {
        $choice = $term->{term}->readline("Choice: ");
      } while (($choice eq '') || ($choice =~ m/[^0-9]/) || ($choice >= scalar(@keys)));
      return $keys[$choice];
    }
  }
  die("Don't know how to prompt for the attribute of types ".join(',',@{$field->{'type'}}));
}

sub command_infos
{
  my ($type) = @_;
  my $infos = rpc_call($client, 'infos', [$sid, $type]);
  while (my ($name, $value) = each(%$infos)) {
    if ($name eq 'tabs') {
      print "tabs:\n";
      foreach my $tab (@$value) {
        print "\t".$tab->{'NAME'}."\t(".$tab->{'CLASS'}.")\n";
      }
    } else {
      printf ("%-22s %s\n", $name.':', $value);
    }
  }
}

sub command_types
{
  my $types = rpc_call($client, 'listTypes', [$sid]);
  while (my ($type, $display) = each(%$types)) {
    printf ("%-30s %s\n", $display, $type);
  }
}

__END__

=head1 NAME

fusiondirectory-shell - A shell to act on FusionDirectory handled objects

=head1 SYNOPSIS

B<fusiondirectory-shell> [I<options>]

=head1 DESCRIPTION

B<fusiondirectory-shell> will connect you to FusionDirectory webservice and allow you to list, display and alter objects.

=head1 OPTIONS

=over 8

=item B<-h>, B<--help>

Print a brief help message and exits.

=item B<-u>, B<--url>=I<HOST>

Use HOST instead of https://localhost/fusiondirectory/jsonrpc.php

=item B<-l>, B<--login>=I<LOGIN>

User login to send

=item B<-p>, B<--password>=I<PWD>

User password to send

=item B<-c>, B<--ca>=I<FILE>

Use CA file FILE to check the server identity

=item B<-s>, B<--server>=I<SERVER>

Use SERVER ldap server on the FusionDirectory instance to connect (if FusionDirectory has several LDAP server configured)

=back

=head1 BUGS

Please report any bugs, or post any suggestions, to the fusiondirectory mailing list fusiondirectory-users or to <https://forge.fusiondirectory.org/projects/fusiondirectory/issues/new>

=head1 AUTHOR

Come Bernigaud

=head1 LICENCE AND COPYRIGHT

=over 2

=item Copyright (C) 2013 FusionDirectory project

=back

License BSD

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 LICENSE file for more details.

=cut