FM / CPanel

/opt/dedrads/perl/IMH/CPanel

Name	Size	Mode	Actions
Agent.pm	6143	0555	edit dl rm
FindUser.pm	2394	0555	edit dl rm
User.pm	3798	0555	edit dl rm

Edit: /opt/dedrads/perl/IMH/CPanel/Agent.pm (6143B)

#!/usr/bin/perl
# encoding: utf-8
#
# author: Kyle Yetter
#
=pod

=head1 IMH::CPanel::Agent

IMH::CPanel::Agent - a class that is used to send and receive cPanel JSON API requests
to and from the local server.

=head1 Summary

use IMH::CPanel::Agent;

#
# pass a cPanel user name to the constructor to specify the target user of the
# API calls
#
my $agent = IMH::CPanel::Agent->new( "userna5" );

#
# Basic API calls for the functions documented at
# http://docs.cpanel.net/twiki/bin/view/SoftwareDevelopmentKit/XmlApi
#
my $result = $agent->quick_api( 'modifyacct', domain => "new-domain.com" );

#
# Version 1 Modular API calls use positional arguments. See documentation at
# http://docs.cpanel.net/twiki/bin/view/ApiDocs/Api1/WebHome
#
my $result = $agent->modular_api_v1( "StatsBar", "stats", display => "ftpaccounts" );

#
# Version 2 Modular API calls use named parameters. See documentation at
# http://docs.cpanel.net/twiki/bin/view/ApiDocs/Api2/WebHome
#
my $result = $agent->modular_api_v2( "StatsBar", "stats", display => "ftpaccounts" );

# All $results above are hashes with contents that vary widely depending upon
# the actual API call. Please read up on the cPanel documentation for more
# information

=cut

# since the local SSL certificate's probably self-signed, allow the query
# to skip certificate verification
$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;

package IMH::CPanel::Agent;

use strict;
use warnings;

our $VERSION = '0.01';

use LWP::UserAgent;
use URI;
use File::Basename;
use File::Slurp qw( slurp read_dir write_file );
use File::Spec::Functions;
use Term::ReadLine;
use JSON::Syck;
use Data::Dumper;
use IMH::Terminal;

our $created_access_key = 0;

# display extra debugging info if true
our $debug  = 0;

# set to 0 when a WHM api call fails
our $api_success = 1;

# the WHM access key to authenticate the calls -- read when needed
our $whm_access_key = undef;

our $console = undef;

sub tidy($) {
  my ( $str ) = @_;
  $str =~ s(\A\r?\n)();
  $str =~ s(\r?\n[ \t]*\z)();
  $str =~ s(^\s*\| ?)()mg;
  return $str;
}

sub agree($) {
  my ( $question ) = @_;
  $question = "$question [yes/no] ";
  $console ||= Term::ReadLine->new( basename( $0 ) );
  $console->newTTY( \*STDIN, \*STDERR );

while ( defined( $_ = $console->readline( $question ) ) ) {
    if ( /^y/i ) {
      return 1;
    } elsif ( /^n/i ) {
      return 0;
    } else {
      print STDERR "Please enter `yes' or `no'\n";
    }
  }
  return 0;
}

sub load_json($) {
  my ( $source ) = @_;
  my $data;
  eval { $data = JSON::Syck::Load( $source ); };
  if ( $@ ) {
    die( $@ . "\nJSON SOURCE:\n" . $source );
  }
  return $data;
}

# this module's missing sometimes, so check if it's available.
# If not, the script will fail in a hard-to-figure-out way.
eval {
  require LWP::Protocol::https;
} or do {
  print STDERR tidy q(
  | The Perl module LWP::Protocol::https is not installed on this system.
  | It can be installed via:
  |   /scripts/perlinstaller LWP::Protocol::https\n
  );

if ( agree( "Do you want to try and install it now?" ) ) {
    my @command = qw( /scripts/perlinstaller LWP::Protocol::https );
    my $status  = system( @command );

die "perlinstaller failed with exit status `$status'" unless $status == 0;

eval { require LWP::Protocol::https; } or do {
      die "the perlinstaller command didn't fail, but I still can't load the LWP::Protocol::https Perl module";
    };
  } else {
    die "cannot run without the LWP::Protocol::https Perl module";
  }
};

sub new {
  my ( $class, $user ) = @_;
  my $object = { user => $user, debug => 0 };
  bless( $object, $class || __PACKAGE__ );
  return $object;
}

sub user {
  my ( $self, @args ) = @_;
  if ( @args ) {
    $self->{user} = $args[ 0 ];
  }
  return $self->{user};
}

sub debug {
  my ( $self, @args ) = @_;
  if ( @args ) {
    $self->{debug} = $args[ 0 ];
  }
  return $self->{debug};
}

sub d {
  my $self = shift;
  if ( $self->{debug} ) {
    my ( $fmt, @params ) = @_;
    local $\ = "\n";

my $message = c( sprintf( $fmt, @params ), 'cyan' );
    print STDERR "DEBUG: $message";
  }
}

sub quick_api {
  my ( $self, $function, %params ) = @_;

my $uri = URI->new( "https://127.0.0.1:2087/json-api/$function" );
  $uri->query_form( %params );
  $self->d( "query URI: %s", $uri );

my $auth    = "WHM root:" . whm_access_key();
  my $ua      = LWP::UserAgent->new;
  my $request = HTTP::Request->new( GET => "$uri" );

$request->header( Authorization => $auth );
  my $response = $ua->request( $request );

my $data = load_json( $response->content );
  $self->d( "json data:\n%s", Dumper( $data ) ) if $self->{debug};
  # ^-- keeps the Dumper call from executing unless totally necessary

$self->{response} = $response;
  return $data;
}

sub modular_api_v1 {
  my ( $self, $module, $func, @args ) = @_;
  my %opts = (
    cpanel_jsonapi_user => $self->{user},
    cpanel_jsonapi_module => $module,
    cpanel_jsonapi_func => $func,
    cpanel_jsonapi_apiversion => 1
  );
  for my $i ( 0 .. $#args ) {
    $opts{ "arg-$i" } = $args[ $i ];
  }
  return $self->quick_api( 'cpanel', %opts );
}

sub modular_api_v2 {
  my ( $self, $module, $func, %params ) = @_;
  my %opts = (
    cpanel_jsonapi_user       => $self->{user},
    cpanel_jsonapi_module     => $module,
    cpanel_jsonapi_func       => $func,
    cpanel_jsonapi_apiversion => 2,
    %params
  );
  my $result = $self->quick_api( 'cpanel', %opts );
  return $result->{ cpanelresult };
}

sub whm_access_key {
  unless ( $whm_access_key ) {
    unless ( -f "/root/.accesshash" ) {
      $ENV{ REMOTE_USER } = 'root';
      `/usr/local/cpanel/bin/mkaccesshash`;
      delete $ENV{ REMOTE_USER };
      $created_access_key = 1;
    }

$whm_access_key = slurp( "/root/.accesshash" ) or die "could not read /root/.accesshash: $!";
    $whm_access_key =~ s/\n//g;
  }
  return $whm_access_key
}

END {
  #
  # If we had to create a temporary access hash to make this work,
  # make sure it gets trashed
  #
  if ( -f '/root/.accesshash' && $created_access_key ) {
    unlink( '/root/.accesshash' ) or die( "failed to remove /root/.accesshash" );
  }
};

cmd: