view release on metacpan or  search on metacpan

lib/App/cpanel.pm  view on Meta::CPAN

use strict;
use warnings;
use Mojo::URL;
use Mojo::UserAgent;
use Mojo::File qw(path);
use Mojo::Util qw(dumper encode);

my %cmd2func = (
  uapi => [ \&uapi_p, 1 ],
  download => [ \&download_p, 0 ],
  upload => [ \&upload_p, 1 ],
  api2 => [ \&api2_p, 1 ],
  mirror => [ \&mirror_p, 1 ],
);
my $token_file = "$ENV{HOME}/.cpanel-token";
my $domain_file = "$ENV{HOME}/.cpanel-domain";
my %localfs_map = (
  ls => \&localfs_ls,
  mkdir => \&localfs_mkdir,
  read => \&localfs_read,
  write => \&localfs_write,
  chmod => \&localfs_chmod,
);
my %cpanel_map = (
  ls => \&cpanel_ls,
  mkdir => \&cpanel_mkdir,
  read => \&cpanel_read,
  write => \&cpanel_write,
  chmod => \&cpanel_chmod,
);
our %MAP2HASH = (
  localfs => \%localfs_map,
  cpanel => \%cpanel_map,
);

sub dispatch_cmd_print {
  my $cmd = shift;
  die "No command\n" unless $cmd;
  die "Unknown command '$cmd'\n" unless my $info = $cmd2func{$cmd};
  my $p = dispatch_cmd_raw_p($cmd, @_);
  $p = $p->then(\&dumper) if $info->[1];
  $p->then(sub { print @_ }, sub { warn encode 'UTF-8', join '', @_ })->wait;
}

sub dispatch_cmd_raw_p {
  my $cmd = shift;
  die "No command\n" unless $cmd;
  die "Unknown command '$cmd'\n" unless my $info = $cmd2func{$cmd};
  goto &{$info->[0]};
}

sub api_request {
  my ($method, $domain, $token, $parts, $args, @extra_args) = @_;
  my ($url_token, $cookie_token) = split /\s+/, $token;
  my $url = Mojo::URL->new("https://$domain:2083");
  $url->path(join '/', '', "cpsess$url_token", @$parts);
  $url->query(%$args) if $args;
  CORE::state $ua = Mojo::UserAgent->new; # state as needs to live long enough to complete request
  $ua->$method(
    $url->to_abs . "",
    { Cookie => "cpsession=$cookie_token" },
    @extra_args,
  );
}

sub read_file {
  my ($file) = @_;
  die "$file: $!\n" unless -f $file;
  die "$file: too readable\n" if (stat $file)[2] & 0044;
  local $/;
  open my $fh, $file or die "$file: $!\n";
  my $content = <$fh>;
  die "No content in '$file'\n" unless $content;
  $content =~ s/^\s*(.*?)\s*$/$1/g;
  $content;
}

sub read_token { read_file($token_file) }
sub read_domain { read_file($domain_file) }

sub _error_or_json {
  my $res = $_[0]->res;
  die $res->code . ": " . $res->message . "\n" if $res->code != 200;
  $res->json;
}

sub _uapi_error_or_json {
  my $json = $_[0];
  if (!$json->{status}) {
    die join '', "Failed:\n",
      map "$_\n", map @{ $json->{$_} || [] }, qw(errors warnings);
  }
  $json;
}

sub uapi_p {
  my ($module, $function, @args) = @_;
  die "No module\n" unless $module;
  die "No function\n" unless $function;
  my ($token, $domain) = (read_token(), read_domain());
  my $args_hash = ref($args[0]) eq 'HASH'
    ? $args[0]
    : { map split('=', $_, 2), @args }
    if @args;
  my $tx_p = api_request 'get_p', $domain, $token,
    [ 'execute', $module, $function ],
    $args_hash;
  $tx_p->then(\&_error_or_json)->then(\&_uapi_error_or_json);
}

sub download_p {
  my ($file) = @_;
  die "No file\n" unless $file;
  my ($token, $domain) = (read_token(), read_domain());
  my $tx_p = api_request 'get_p', $domain, $token,
    [ 'download' ],
    { skipencode => 1, file => $file };
  $tx_p->then(sub {
    my $res = $_[0]->res;
    die $res->code . ": " . $res->message . "\n" if $res->code != 200;
    $res->body;