#! /usr/bin/perl -wT

use strict;
use warnings;
use Sys::Syslog();
use Fcntl();
use Symbol();
use Getopt::Long();
use English qw( -no_match_vars );

delete $ENV{PATH};

local $ENV{PATH} = '/usr/bin:/bin:/usr/sbin:/sbin';

our $VERSION = '0.98_01';

my $binary = 'firefox';
my $ident  = 'ssh-auth-cmd-firefox-marionette';

my %options = ( 'facility' => 'LOG_LOCAL0' );
eval {
    Getopt::Long::GetOptions( \%options, 'help', 'version', 'facility:s' );
    if ( $options{help} ) {
        print
          <<"_USAGE_" or die "Failed to print to STDOUT:$EXTENDED_OS_ERROR\n";
Usage: $PROGRAM_NAME [--help] [--version] [--facility=(LOG_LOCAL0|LOG_LEVEL1|..)]

This program is intended to allow secure remote usage of the perl Firefox::Marionette library via ssh.  It allows a list
of pre-defined commands that can be permitted via ssh public key authentication.

Be default, it will log all commands that the remote perl library requests to run on this machine to the LOG_LOCAL0 syslog
facility.  If desired, syslog messages can be sent to a facility of your choosing, using the syslog(3) documentation for
a list of allowed facilities and the --facility argument for this program.

An example .ssh/authorized_keys file using this program would look like this 

   no-agent-forwarding,no-pty,no-X11-forwarding,permitopen="127.0.0.1:*",command="/usr/local/bin/ssh-auth-cmd-firefox-marionette" ssh-rsa AAAA ... == user\@server

_USAGE_
        exit 0;
    }
    elsif ( $options{version} ) {
        print "$VERSION\n"
          or die "Failed to print to STDOUT:$EXTENDED_OS_ERROR\n";
        exit 0;
    }
    if ( !defined $ENV{SSH_ORIGINAL_COMMAND} ) {
        die
"$PROGRAM_NAME requires the SSH_ORIGINAL_COMMAND environment variable to be defined\n";
    }
    my $tmp_directory = $ENV{TMPDIR} || '/tmp';
    my $root_dir_regex;
    my $quoted_tmp_directory;
    if ( $tmp_directory =~
        s/^(.*firefox_marionette_remote\w+)(?:\/tmp)?$/$1/smx )
    {
        $quoted_tmp_directory = quotemeta $tmp_directory;
        $root_dir_regex       = qr/$quoted_tmp_directory/smx;
    }
    else {
        $quoted_tmp_directory = quotemeta $tmp_directory;
        $root_dir_regex =
          qr/$quoted_tmp_directory\/firefox_marionette_remote\w+/smx;
    }
    my $sub_directory_regex = qr/(?:profile|downloads|tmp|addons|certs)/smx;
    my $profile_file_regex =
      qr/profile\/(?:bookmarks[.]html|prefs[.]js|mimeTypes[.]rdf)/smx;
    my $file_regex      = qr/[+\w\-()]{1,255}(?:[.][+\w\-()]{1,255})*/smx;
    my $downloads_regex = qr/downloads\/$file_regex/smx;
    my $ca_name_regex   = qr/Firefox::Marionette[ ]Root[ ]CA/smx;
    my $certutil_arguments_regex = join q[],
      qr/[ ]\-A/smx,
      qr/[ ]\-d[ ](?:dbm|sql):$root_dir_regex\/profile/smx,
      qr/[ ]\-i[ ]$root_dir_regex\/certs\/root_ca_\d{1,10}[.]cer/smx,
      qr/[ ]\-n[ ]$ca_name_regex[ ]\d{1,10}[ ]\-t[ ]TC,,/smx;
    my $firefox_arguments_regex = join q[],
      qr/[ ]\-marionette/smx,
      qr/(?:[ ]\-width[ ]\d{1,8})?/smx,
      qr/(?:[ ]\-height[ ]\d{1,8})?/smx,
      qr/(?:[ ]-safe\-mode)?/smx,
      qr/(?:[ ]\-headless)?/smx,
      qr/[ ]\-profile[ ]$root_dir_regex\/profile/smx,
      qr/[ ]\-\-no\-remote/smx,
      qr/[ ]\-\-new\-instance/smx,
      qr/(?:[ ]\-\-devtools)?/smx;
    my $prefs_grep_patterns_regex = join q[],
      qr/\-e[ ]marionette\\.port[ ]/smx,
      qr/\-e[ ]security\\.sandbox\\.content\\.tempDirSuffix[ ]/smx,
      qr/\-e[ ]security\\.sandbox\\.plugin\\.tempDirSuffix[ ]/smx;
    my $allowed_commands_regex = join q[|],
      qr/"$binary"[ ]\-\-version/smx,
      qr/uname[ ][|][|][ ]ver/smx,
      qr/echo[ ]"TMPDIR=\\"\$TMPDIR\\""/smx,
      qr/echo[ ]"TMP=\\"\$TMP\\""/smx,
      qr/mkdir[ ](?:\-m[ ]700[ ])?$root_dir_regex/smx,
      qr/mkdir[ ](?:\-m[ ]700[ ])?$root_dir_regex\/$sub_directory_regex/smx,
      qr/scp[ ]\-p[ ]\-t[ ]"$root_dir_regex\/$profile_file_regex"/smx,
      qr/scp[ ]\-p[ ]\-t[ ]"$root_dir_regex\/addons\/$file_regex"/smx,
      qr/scp[ ]\-p[ ]\-t[ ]"$root_dir_regex\/certs\/root_ca_\d{1,10}[.]cer"/smx,
      qr/scp[ ]\-p[ ]\-[tf][ ]"$root_dir_regex\/$downloads_regex"/smx,
      qr/kill[ ]\-0[ ]\d{1,8}/smx,
      qr/ps[ ]xwwe/smx,
qr/rm[ ]\-Rf[ ]$root_dir_regex(?:[ ]$quoted_tmp_directory\/Temp\-[\d\-a-f]{1,255})*/smx,
      qr/ls[ ]-1[ ]"$root_dir_regex\/downloads"/smx,
      qr/certutil$certutil_arguments_regex/smx,
      qr/"$binary"$firefox_arguments_regex/smx,
qr/grep[ ]$prefs_grep_patterns_regex$root_dir_regex\/profile\/prefs[.]js/smx;

    if ( $ENV{SSH_ORIGINAL_COMMAND} =~ m/^($allowed_commands_regex)$/smx ) {
        my ($command_and_arguments) = ($1);
        Sys::Syslog::openlog( $ident, 'cons', $options{facility} );
        Sys::Syslog::syslog( 'info', "Executing '$command_and_arguments'" );
        Sys::Syslog::closelog();
        exec $command_and_arguments
          or die "Failed to '$command_and_arguments':$EXTENDED_OS_ERROR\n";
    }
    else {
        die 'Unrecognisable command "'
          . $ENV{SSH_ORIGINAL_COMMAND}
          . "\" with a quoted TMPDIR of \"$quoted_tmp_directory\" and a root directory regex of \"$root_dir_regex\"\n";
    }
    1;
} or do {
    my $eval_error = $EVAL_ERROR;
    chomp $eval_error;
    Sys::Syslog::openlog( $ident, 'cons', $options{facility} );
    Sys::Syslog::syslog( 'err', $eval_error );
    Sys::Syslog::closelog();
    warn "$eval_error\n";
    exit 1;
};

