convos

#!/usr/bin/env perl
BEGIN {
  if ($ENV{SNAP} and $ENV{SNAP_USER_COMMON}) {
    $ENV{CONVOS_HOME} ||= $ENV{SNAP_USER_COMMON};
    @INC = map {
      my $local = "$ENV{SNAP}$_";    # Example: /snap/convos/x45/usr/share/perl5
      warn "INC: $local / $_\n" if $ENV{CONVOS_SNAP_DEBUG};
      -e $local ? $local : $_;
    } @INC;
  }
}

# IMPORTANT: Cannot load Mojo::File or any other module before they are installed
use feature 'state';
use strict;
use warnings;
use Config;
use Cwd ();
use File::Spec;
use FindBin;

our $VERSION = '5.06';

# Run the program
(bless {}, __PACKAGE__)->run(@ARGV);

# Need to be first, because it is called without parenthesis
sub path_to {
  state $home = Cwd::realpath(File::Spec->catdir($FindBin::Bin, File::Spec->updir));
  return File::Spec->catfile($home, @_);
}

sub command_build {
  my ($script, @cmd) = @_;
  $ENV{BUILD_ASSETS} = 1;
  $ENV{RELEASE} //= @cmd && $cmd[0] eq 'release';
  my @tests = qw(t/production-resources.t);
  push @tests, 't/version.t' if $ENV{RELEASE};
  $script->command_exec(qw(prove -l), @tests);
}

sub command_cpanm {
  my ($script, @cmd) = @_;
  state $cpanm
    = do { my $cpanm = path_to 'script', 'cpanm'; -r $cpanm ? [$^X, $cpanm] : ['cpanm'] };

  $ENV{CPAN_MIRROR} //= 'https://cpan.metacpan.org' if eval 'require IO::Socket::SSL;1';
  unshift @cmd, -l => $ENV{CONVOS_LOCAL_LIB};
  unshift @cmd, -M => $ENV{CPAN_MIRROR} if $ENV{CPAN_MIRROR};
  $script->command_exec(@$cpanm, @cmd);
}

sub command_dev {
  my $script = shift;
  my @cmd    = $script->_cmd_with_secure_listen(@_);
  $ENV{$_} //= 1 for qw(LINK_EMBEDDER_ALLOW_INSECURE_SSL CONVOS_DEBUG);
  push @cmd, qw(-w lib -w public/convos-api.yaml -w templates) unless grep {/^-?-w/} @cmd;
  warn "\$ script/convos webpack @cmd\n";
  exec $^X => qw(script/convos), webpack => @cmd;
  die "Could not exec $^X script/convos webpack @cmd: $!\n";
}

sub command_exec {
  my ($script, @cmd) = @_;
  return $script->command_help if !@cmd or $cmd[0] =~ /^--?h/;
  warn sprintf "\$ %s\n", join ' ', @cmd;
  return system(@cmd) ? 0 : 1;
}

sub command_help {
  my $script = shift;
  print <<"HERE";

Usage: $0 COMMAND [OPTIONS]

Examples:
  convos daemon
  convos daemon --help
  convos exec env | sort
  convos exec prove -l
  convos get /sw.js
  convos get --help
  convos install
  convos install [--all|--dev|--prod]
  convos version

For developers:
  convos build
  convos build release
  convos cpanm
  convos dev
  convos dev --help
  convos eval 'say app->core->home'
  convos eval --help

Commands:
  build    Build JavaScript and CSS assets
  cpanm    Run cpanm and install to local lib
  daemon   Start the Convos server
  dev      Start the Convos development server
  eval     Run Perl code against Convos
  exec     Run shell command with Convos environment
  get      Perform HTTP request
  install  Install dependencies
  upgrade  Upgrade Convos to latest version
  version  Show versions of available modules

See also https://convos.chat/doc for more information.

HERE
}

sub command_install {
  my ($script, $mode) = (@_, '--prod');
  return $script->command_help if $mode =~ /^--?h/;

  # @missing = ([mode, name, version, error], ...)
  my @missing = grep { $_->[3] } $script->_dependencies;
  @missing = grep { $_->[0] ne 'develop' } @missing  if $mode =~ /^--?all/;
  @missing = grep { $_->[0] eq 'requires' } @missing if $mode =~ /^--?prod/;
  $script->command_cpanm(-n => $_->[1]) or die "cpanm failed: $?\n" for @missing;

  $script->command_version;
  print <<"HERE";

All dependencies are installed for "$mode".

You can now run "$0 daemon --listen http://*:8000" to start Convos,
or "$0 help" for more information.

HERE
}

sub command_upgrade {
  my $script = shift;

  my $home = path_to;
  chdir $home or die "Couldn't change working directory to $home: $!";

  if (-d '.git') {
    my %branches = map { s![\s\r\n]+$!!; my $c = !!s!\*\s*!!; ($_ => $c) } qx(git branch);
    my ($branch) = grep { $branches{$_} } keys %branches;
    die qq(Couldn't find active git branch in "$home".\n) unless $branch;
    $script->_run_or_abort(qw(git pull origin) => $branch);
  }
  else {
    my $version = $ENV{CONVOS_WANTED_VERSION} || 'stable';                         # experimental
    my $url     = "https://github.com/nordaaker/convos/archive/$version.tar.gz";
    my $tar     = _which('tar') or die qq(Couldn't find executable "tar".);
    my $tar_cmd = "$tar xz --strip-components 1";

    if (my $curl = _which('curl')) {
      $script->_run_or_abort("$curl -s -L $url | $tar_cmd");
    }
    elsif (my $wget = _which('wget')) {
      $script->_run_or_abort("$wget -q -O - $url | $tar_cmd");
    }
    else {
      die qq(Couldn't find executable "curl" or "wget".);
    }
  }

  return $script->command_install;
}

sub command_version {
  my $script = shift;
  my @deps
    = map { $_->[3] ||= $_->[1]->VERSION; [$_->[0], sprintf "  %-30s %-10s (%s)\n", @$_[1, 3, 2]] }
    sort { $a->[1] cmp $b->[1] } $script->_dependencies;

  unshift @deps, [requires => sprintf "  %-30s %-10s (%s)\n", 'Perl',   $^V,      '5.16'];
  unshift @deps, [requires => sprintf "  %-30s %-10s (%s)\n", 'Convos', $VERSION, $VERSION];

  my $dev_deps = join '', map { $_->[1] } grep { $_->[0] eq 'develop' } @deps;
  my $req_deps = join '', map { $_->[1] } grep { $_->[0] eq 'requires' } @deps;
  my $opt_deps = join '', map { $_->[1] } grep { $_->[0] eq 'suggests' } @deps;

  print <<"HERE";

CORE
$req_deps
OPTIONAL
$opt_deps
DEVELOPMENT
$dev_deps
HERE
}

sub run {
  my $script = shift;
  return $script->command_help if !@_ or $_[0] =~ /^--?h/;

  my $command = shift;
  my $method  = $script->can("command_$command");

  $script->_setup_inc;
  $script->_setup_env($command => @_);
  $script->_exit($method => @_) if $method;
  $script->_exit(1) unless $script->_dependencies_are_installed;

  # Start Convos
  require Mojolicious::Commands;
  $script->_warn_running_as_root if +(!$< or !$>) and !$ENV{CONVOS_NO_ROOT_WARNING};
  Mojolicious::Commands->start_app('Convos');
}

sub _cmd_with_secure_listen {
  my ($script, @cmd) = @_;
  require Mojo::URL;

  my $url;
  my $i = 0;
  while ($i < @cmd) {
    $url = Mojo::URL->new($cmd[$i]) if $cmd[$i] =~ m!^https?:!;
    $i++;
  }

  $i = @cmd unless $url;
  $url ||= Mojo::URL->new('https://*:3443');
  return @cmd if $url->scheme eq 'http';

  $url->query->param(cert => $ENV{CONVOS_TLS_CERT}) if $ENV{CONVOS_TLS_CERT};
  $url->query->param(key  => $ENV{CONVOS_TLS_KEY})  if $ENV{CONVOS_TLS_KEY};

  return @cmd unless $url->query->param('cert') and $url->query->param('key');
  splice @cmd, $i, 0, ($i == @cmd ? ('--listen') : ()), $url->to_string;
  return @cmd;
}

sub _dependencies {
  my $script = shift;
  $script->_setup_inc;

  my @dependencies;
  my $load = sub {
    my ($mode, $module, $version) = @_;
    local ($@, $!) = ('', 0);
    eval "use $module $version ();1";
    my $err = $@;
    $err =~ s! at .*!!s;
    $err =~ s! in \@INC.*!!s;
    $err =~ s!$module.*--.*?([\d\._]+).*!You have version $1!;
    push @dependencies, [$script->{cpanfile_mode} || $mode, $module, $version, $err];
  };

  no warnings 'once';
  local $script->{cpanfile_mode};
  local *main::on            = sub { local $script->{cpanfile_mode} = shift; shift->() };
  local *main::requires      = sub { $load->(requires => @_) };
  local *main::suggests      = sub { $load->(suggests => @_) };
  local *main::test_requires = sub { $load->(test => @_) };

  local ($@, $!) = ('', 0);
  do $ENV{CONVOS_CPAN_FILE};
  my $err = $@ || $!;
  die "Could not source $ENV{CONVOS_CPAN_FILE}: $err\n" if $err;

  return @dependencies;
}

sub _dependencies_are_installed {
  my $script = shift;
  return 1 if $ENV{CONVOS_SKIP_DEPENDENCIES_CHECK}++;
  return 1 unless -e $ENV{CONVOS_CPAN_FILE};
  return 1 unless grep { $_->[0] eq 'requires' and $_->[3] } $script->_dependencies;

  $script->command_version;
  print <<"HERE";

It is not possible to start Convos at this point, since there
are some missing dependencies that need to be installed.

Run "$0 install" to install the missing dependencies above.

HERE

  return 0;
}

sub _exit {
  my ($script, $method, @params) = @_;
  exit $method              if $method =~ m!^\d+$!;
  $script->$method(@params) if $method;
  exit 0 + ($? || $!);
}

sub _run_or_abort {
  my ($script, @cmd) = @_;
  return if $script->command_exec(@cmd);
  my $exit_value = $? >> 8;
  die "# Couldn't execute @cmd: $exit_value\n";
}

sub _setup_env {
  my ($script, $command) = @_;
  local ($@, $!) = ('', 0);

  $ENV{CONVOS_CPAN_FILE} ||= path_to 'cpanfile';
  $ENV{CONVOS_LOCAL_LIB} ||= path_to 'local';
  $ENV{LINK_EMBEDDER_FORCE_SECURE} //= 1;    # Make sure LinkEmbedder upgrade http to https
  $ENV{MOJO_LOG_LEVEL} ||= 'fatal'      if grep { $command eq $_ } qw(get version);
  $ENV{MOJO_MODE}      ||= 'production' if $command eq 'daemon';
  $ENV{MOJO_NPM_BINARY} = 'pnpm';
  $ENV{PERL5LIB}        = join ':', @INC;

  my $bin = path_to 'local', 'bin';
  $ENV{PATH} = join ':', grep {$_} $bin, $ENV{PATH} if -d $bin;

  opendir my $DH, path_to;
  while ($DH and (my $file = readdir $DH)) {
    my $file = path_to $file;
    $ENV{CONVOS_TLS_KEY}  = $file and next if $file =~ m!-key\.pem$!;
    $ENV{CONVOS_TLS_CERT} = $file and next if $file =~ m!\.pem$!;
  }
}

sub _setup_inc {
  my $script = shift;
  local ($@, $!) = ('', 0);

  # Where cpanm might have installed dependencies to
  unshift @INC,
    grep {-d} map { path_to 'local', 'lib', 'perl5', @$_ }[$Config{version}, $Config{archname}],
    [$Config{version}], [$Config{archname}], [];

  # Where Convos lives
  unshift @INC, path_to 'lib';

  # Force PERL5LIB to be loaded before the custom @INC directories above
  unshift @INC, split /:/, $ENV{PERL5LIB} if $ENV{PERL5LIB};

  my %uniq;
  @INC = grep { !$uniq{$_}++ } @INC;    # duplicates are caused by "dev" command
  pop @INC if $INC[-1] eq '.';          # don't care about current dir
}

sub _warn_running_as_root {
  print <<"HERE";

  UID  = $<
  EUID = $>
  USER = $ENV{USER}

  --------------------------------------------------------------------
  WARNING!
  --------------------------------------------------------------------

  You should NOT run Convos as root!

  It is not considered a good security practice to run servers as the
  root user.

  Note that if you used to run Convos as root, then you have to change
  ownership to files in your "\$CONVOS_HOME" directory.

  We strongly encourage you to change to a less privileged user.

  --------------------------------------------------------------------

HERE
}

sub _which {
  my $name = shift;
  for my $dir (split ':', $ENV{PATH}) {
    my $path = File::Spec->catfile($dir, $name);
    return $path if -x $path;
  }
  return undef;
}