#!/usr/bin/perl

########################################################################
#
# fusiondirectory-shell
#
# A shell to act on FusionDirectory handled objects
# See pod documentation at the end of the file
#
#  This code is part of FusionDirectory (http://www.fusiondirectory.org/)
#  Copyright (C) 2015-2016  FusionDirectory
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  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
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
#
########################################################################

use strict;
use warnings;

use 5.008;

use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use Term::ShellUI;

use JSON::RPC ();
use constant USE_LEGACY_JSON_RPC => ($JSON::RPC::VERSION > 0.96);
use if (USE_LEGACY_JSON_RPC),     'JSON::RPC::Legacy::Client';
use if not (USE_LEGACY_JSON_RPC), 'JSON::RPC::Client';

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

# Process command-line
Getopt::Long::config('no_ignore_case');
GetOptions(
  'help|?'      => \$help,
  'url=s'       => \$host,
  'ca=s'        => \$ca_file,
  'login=s'     => \$login,
  'password=s'  => \$password,
  'P'           => \$password_ask,
  'server=s'    => \$ldap_server
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(2) if not defined $login;
pod2usage(2) if not defined $password and not $password_ask;

if ($host !~ m/jsonrpc\.php$/) {
  if ($host !~ m|/$|) {
    $host .= '/';
  }
  $host .= 'jsonrpc.php'
}

my $current_base;

sub rpc_init {
  my $client;
  if (USE_LEGACY_JSON_RPC) {
    $client = new JSON::RPC::Legacy::Client;
  } else {
    $client = new JSON::RPC::Client;
  }

  $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",
      doc     => "Usage: help [<COMMAND>]\nExample: help cd\n",
      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",
      doc     => "Usage: cd [<BASE>]\nExample: cd ou=department,dc=example,dc=com\nIf BASE is not supplied, change current base to LDAP root\n",
      maxargs => 1,
      proc    => \&command_cd,
    },
    "chdir" => { alias => 'cd' },
    "pwd" => {
      desc    => "Print the current working directory",
      doc     => "Usage: pwd\n",
      maxargs => 0,
      proc    => sub { print $current_base."\n"; },
    },
    "ls" => {
      desc    => "List objects of a given type",
      doc     => "Usage: ls <TYPE> [<ATTRIBUTE> [<FILTER>]]\nLists objects of type TYPE, outputting ATTRIBUTE and their dn\nYou can provide FILTER if you want to filter what is displayed\nExample: ls user\nExample: ls user cn (objectClass=posixAccount)\n",
      minargs => 1,
      maxargs => 3,
      proc    => \&command_ls,
    },
    "count" => {
      desc    => "Count objects of a given type",
      doc     => "Usage: count <TYPE> [<FILTER>]\nExample: count user\nExample: count user (objectClass=posixAccount)\n",
      minargs => 1,
      maxargs => 2,
      proc    => \&command_count,
    },
    "cat" => {
      desc    => "Show an object information",
      doc     => "Usage: cat <TYPE> [<DN> [<TAB>]]\nDisplays tab TAB (defaults to main tab) of object DN\nIf DN is not provided, just list fields of main tab of type TYPE\nExample: cat user uid=fd-admin,dc=example,dc=com\nExample: cat user\nExample: cat user uid=fd-admin,dc=example,dc=com posixAccount\n",
      minargs => 1,
      maxargs => 3,
      proc    => \&command_cat,
    },
    "lstabs" => {
      desc    => "List an object activated tabs",
      doc     => "Usage: lstabs <TYPE> [<DN>]\nLists activated tabs of object DN\nIf DN is not provided, just list tabs activated on creation of an object of type TYPE\nExample: lstabs user uid=fd-admin,dc=example,dc=com\nExample: lstabs user\n",
      minargs => 1,
      maxargs => 2,
      proc    => \&command_lstabs,
    },
    "infos" => {
      desc    => "Show information about a type",
      doc     => "Usage: infos <TYPE>\nExample: infos user\n",
      minargs => 1,
      maxargs => 1,
      proc    => \&command_infos,
    },
    "types" => {
      desc    => "List existing types",
      doc     => "Usage: types\n",
      minargs => 0,
      maxargs => 0,
      proc    => \&command_types,
    },
    "create" => {
      desc    => "Create an object of a given type, optionaly with the given tabs",
      doc     => "Usage: create <TYPE> [<TABS>]\nExample: create user\nExample: create user posixAccount\n",
      minargs => 1,
      proc    => \&command_create,
    },
    "delete" => {
      desc    => "Delete an object of a given type",
      doc     => "Usage: delete <TYPE> <DN>\nExample: delete user uid=fd-admin,dc=example,dc=com\n",
      minargs => 2,
      maxargs => 2,
      proc    => \&command_delete,
    },
    "addtab" => {
      desc    => "Activate a tab (or several) of an object",
      doc     => "Usage: addtab <TYPE> <DN> <TAB> [<TABS>]\nExample: addtab user uid=fd-admin,dc=example,dc=com posixAccount\n",
      minargs => 3,
      maxargs => 3,
      proc    => \&command_addtab,
    },
    "removetab" => {
      desc    => "Deactivate a tab of an object",
      doc     => "Usage: removetab <TYPE> <DN> <TAB>\nExample: removetab user uid=fd-admin,dc=example,dc=com posixAccount\n",
      minargs => 3,
      maxargs => 3,
      proc    => \&command_removetab,
    },
    "setvalue" => {
      desc    => "Set the value of a field of an object",
      doc     => "Usage: setvalue <TYPE> <DN> <TAB> <FIELD> [<VALUE>]\nExample: setvalue user uid=fd-admin,dc=example,dc=com posixAccount loginShell /bin/bash\n",
      minargs => 4,
      proc    => \&command_setvalue,
    },
    "addvalue" => {
      desc    => "Add a value to a multivaluated field of an object",
      doc     => "Usage: addvalue <TYPE> <DN> <TAB> <FIELD> <VALUE>\nExample: addvalue user uid=fd-admin,dc=example,dc=com user title Administrator\n",
      minargs => 5,
      maxargs => 5,
      proc    => \&command_addvalue,
    },
    "delvalue" => {
      desc    => "Remove a value from a multivaluated field of an object",
      doc     => "Usage: delvalue <TYPE> <DN> <TAB> <FIELD>\nExample: delvalue user uid=fd-admin,dc=example,dc=com user title\n",
      minargs => 4,
      maxargs => 4,
      proc    => \&command_delvalue,
    },
    "exit" => {
      desc    => "Exit FusionDirectory shell",
      doc     => "Usage: exit\n",
      maxargs => 0,
      method  => sub { shift->exit_requested(1); },
    }
  },
  history_file => '~/.fusiondirectory_shell_history',
);


if ($password_ask) {
  $password = $term->{term}->readline('Password: ');
}

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, $filter) = @_;
  if (! defined $filter) {
    $filter = '';
  }
  my $res = rpc_call($client, 'ls', [$sid,$type,$attrs,$current_base,$filter]);
  if (ref $res eq ref {}) {
    while (my ($dn, $display) = each(%$res))
    {
      print "$display\t($dn)\n";
    }
  }
}

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

sub command_cd
{
  my ($path) = @_;
  if (! defined $path) {
    $path = $base;
  }
  $current_base = complete_dn($path);
}

sub command_cat
{
  my ($type, $path, $tab) = @_;
  $path = complete_dn($path);
  my $fields = rpc_call($client, 'formfields', [$sid,$type,$path,$tab]);
  if (ref $fields eq ref {}) {
    my $sectionhash = $fields->{'sections'};
    foreach my $sectionkey ( @{$fields->{'sections_order'}} ) {
      my $section = $sectionhash->{$sectionkey};
      print '['.$section->{'name'}.']'."\n";
      if (ref $section->{'attrs_order'} eq ref []) {
        my $hash = $section->{'attrs'};
        foreach my $key ( @{$section->{'attrs_order'}} ) {
          show_field($key, $hash->{$key});
        }
      }
    }
  }
}

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

sub ask_field
{
  my ($field) = @_;
  if (!($field->{'visible'})) {
    return $field->{'value'};
  }
  if ($field->{'disabled'}) {
    print $field->{'label'}.": ".$field->{'value'}."\n";
    return $field->{'value'};
  }
  foreach my $type (@{$field->{'type'}}) {
    if ($type eq 'CompositeAttribute') {
      my $attributeshash = $field->{'attributes'};
      my @values = ();
      foreach my $key ( @{$field->{'attributes_order'}} ) {
        my $attribute = $attributeshash->{$key};
        push @values, ask_field($attribute);
      }
      return \@values;
    } elsif ($type eq 'SetAttribute') {
      print $field->{'label'}." (multiple values, empty line to finish):\n";
      my @values = ();
      my $value = $term->{term}->readline("");
      while ($value ne '') {
        push @values, $value;
        $value = $term->{term}->readline("");
      };
      return \@values;
    } elsif (grep {$type eq $_} ('StringAttribute', 'IntAttribute')) {
      return $term->{term}->readline($field->{'label'}.": ");
    } elsif ($type eq 'SelectAttribute') {
      print $field->{'label'}.":\n";
      my $i = 0;
      my @keys = sort(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";
      }
      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_lstabs
{
  my ($type, $path) = @_;
  $path = complete_dn($path);
  my $tabs = rpc_call($client, 'listTabs', [$sid,$type,$path]);
  while (my ($tab, $infos) = each(%$tabs)) {
    printf ("%-30s %s(%s)\n", $infos->{'name'}, $tab, $infos->{'active'} ? 'active' : 'inactive');
  }
}

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);
  }
}

sub command_delete
{
  my ($type, $dn) = @_;
  $dn = complete_dn($dn);
  my $result = rpc_call($client, 'delete', [$sid,$type,$dn]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
    return;
  }
}

sub command_create
{
  my ($type, @tabs) = @_;
  command_addtab($type, undef, undef, @tabs);
}

sub command_addtab
{
  my ($type, $dn, $tab, @tabs) = @_;
  $dn = complete_dn($dn);
  if (not defined $tab) {
    my $infos = rpc_call($client, 'infos', [$sid, $type]);
    # Get the first tab
    my ($tabobject) = @{$infos->{'tabs'}};
    $tab = $tabobject->{'CLASS'};
  }
  my $fields = rpc_call($client, 'getfields', [$sid,$type,$dn,$tab]);
  my %values = ();
  if (ref $fields eq ref {}) {
    my $sectionhash = $fields->{'sections'};
    foreach my $sectionkey ( @{$fields->{'sections_order'}} ) {
      my $section = $sectionhash->{$sectionkey};
      print '['.$section->{'name'}.']'."\n";
      if (ref $section->{'attrs_order'} eq ref []) {
        my $hash = $section->{'attrs'};
        foreach my $key ( @{$section->{'attrs_order'}} ) {
          my $field = $hash->{$key};
          if ($field->{'required'} && !$field->{'disabled'}) {
            $values{$key} = ask_field($field);
          }
        }
      }
    }
  }
  my $result = rpc_call($client, 'setfields', [$sid,$type,$dn,{$tab => \%values}]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
    return;
  } elsif (not defined $dn) {
    print "$result\n";
    $dn = $result;
  }
  if (scalar(@tabs) > 0) {
    command_addtab($type, $dn, @tabs);
  }
}

sub command_setvalue
{
  my ($type, $dn, $tab, $asked_field, @value) = @_;
  $dn = complete_dn($dn);
  my $fields = rpc_call($client, 'formfields', [$sid,$type,$dn,$tab]);
  my %values = ();
  my $found = 0;
  if (ref $fields eq ref {}) {
    my $sectionhash = $fields->{'sections'};
    foreach my $sectionkey ( @{$fields->{'sections_order'}} ) {
      my $section = $sectionhash->{$sectionkey};
      if (ref $section->{'attrs_order'} eq ref []) {
        my $hash = $section->{'attrs'};
        if (defined $hash->{$asked_field}) {
          $found = 1;
          my $field = $hash->{$asked_field};
          if (scalar(@value) == 0) {
            $values{$asked_field} = ask_field($field);
          } elsif (grep {$_ eq 'SetAttribute'} @{$field->{'type'}}) {
            print "Error: Can’t use setvalue on SetAttributes like $asked_field\n";
            return;
          } else {
            $values{$asked_field} = $value[0];
          }
        }
      }
    }
  }
  if (!$found) {
    print "Error: Could not find $asked_field in tab $tab of type $type\n";
    return;
  }
  my $result = rpc_call($client, 'formpost', [$sid,$type,$dn,$tab,\%values]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
  }
}

sub command_addvalue
{
  my ($type, $dn, $tab, $asked_field, $value) = @_;
  $dn = complete_dn($dn);
  my $fields = rpc_call($client, 'formfields', [$sid,$type,$dn,$tab]);
  my %values = ();
  my $found = 0;
  if (ref $fields eq ref {}) {
    my $sectionhash = $fields->{'sections'};
    foreach my $sectionkey ( @{$fields->{'sections_order'}} ) {
      my $section = $sectionhash->{$sectionkey};
      if (ref $section->{'attrs_order'} eq ref []) {
        my $hash = $section->{'attrs'};
        if (defined $hash->{$asked_field}) {
          $found = 1;
          my $field = $hash->{$asked_field};
          if (grep {$_ eq 'SetAttribute'} @{$field->{'type'}}) {
            $values{$asked_field} = $value;
            $values{'add'.$asked_field} = 1;
          } else {
            print "Error: Can’t use addvalue on something else than a SetAttribute\n";
            return;
          }
        }
      }
    }
  }
  if (!$found) {
    print "Error: Could not find $asked_field in tab $tab of type $type\n";
    return;
  }
  my $result = rpc_call($client, 'formpost', [$sid,$type,$dn,$tab,\%values]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
  }
}

sub command_delvalue
{
  my ($type, $dn, $tab, $asked_field) = @_;
  $dn = complete_dn($dn);
  my $fields = rpc_call($client, 'formfields', [$sid,$type,$dn,$tab]);
  my %values = ();
  my $found = 0;
  if (ref $fields eq ref {}) {
    my $sectionhash = $fields->{'sections'};
    foreach my $sectionkey ( @{$fields->{'sections_order'}} ) {
      my $section = $sectionhash->{$sectionkey};
      if (ref $section->{'attrs_order'} eq ref []) {
        my $hash = $section->{'attrs'};
        if (defined $hash->{$asked_field}) {
          $found = 1;
          my $field = $hash->{$asked_field};
          if (grep {$_ eq 'SetAttribute'} @{$field->{'type'}}) {
            show_field($asked_field, $field);
            my $i = 0;
            if (scalar(@{$field->{'value'}}) eq 0) {
              return '';
            }
            for ($i = 0; $i < scalar(@{$field->{'value'}}); $i++) {
              print $i.":".${$field->{'value'}}[$i]."\n";
            }
            my $choice;
            do {
              $choice = $term->{term}->readline("Value(s) to remove (space separated): ");
            } while (($choice eq '') || ($choice =~ m/[^ 0-9]/));

            $values{'row'.$asked_field} = [split(m/\s+/, $choice)];
            $values{'del'.$asked_field} = 1;
          } else {
            print "Error: Can’t use delvalue on something else than a SetAttribute\n";
            return;
          }
        }
      }
    }
  }
  if (!$found) {
    print "Error: Could not find $asked_field in tab $tab of type $type\n";
    return;
  }
  my $result = rpc_call($client, 'formpost', [$sid,$type,$dn,$tab,\%values]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
  }
}

sub command_removetab
{
  my ($type, $dn, $tab) = @_;
  $dn = complete_dn($dn);
  my $result = rpc_call($client, 'removetab', [$sid,$type,$dn,$tab]);
  if (ref $result eq ref {}) {
    foreach my $error (@{$result->{'errors'}}) {
      print "Error: $error\n";
    }
  }
}

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

__END__

=head1 NAME

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

=head1 SYNOPSIS

B<fusiondirectory-shell> [-h] [-u I<URL>] [-c I<FILE>] -l I<LOGIN> (-p I<PWD> | -P) [-s I<LDAPSERVER>]

=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<URL>

Use URL 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<-P>

Prompt for 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) 2015-2016 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
