#! /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_02';

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

my %options = ( facility => 'LOG_LOCAL0' );
eval {
    Getopt::Long::GetOptions( \%options, 'help', 'version', 'facility:s',
        'allow-binary:s@', 'force-binary: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|..)] (--allow-binary=\$path_to_firefox_binary) [--force-binary=\$path_to_firefox_binary]

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-marionette" ssh-rsa AAAA ... == user\@server

By default, the only firefox version that may be used will be present in the PATH environment variable.  However, the remote user may be permitted to specify the
path to a different firefox binary with (multiple) --allow-binary parameters, or simply forced to use the firefox that the local user is setup for with the 
--force-binary parameter.

_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";
    }
    if ( !defined $options{'allow-binary'} ) {
        $options{'allow-binary'} = ['firefox'];
    }
    if (   ( defined $options{'force-binary'} )
        && ( $options{'force-binary'} =~ /^(.*)$/smx ) )
    {
        my ($untainted) = ($1);
        $options{'force-binary'} =
          $untainted; # passed in on the command line from .authorized_keys file
        Sys::Syslog::openlog( $ident, 'cons', $options{facility} );
        Sys::Syslog::syslog( Sys::Syslog::LOG_DEBUG(),
            "Untainting --force-binary of '$options{'force-binary'}'" );
        Sys::Syslog::closelog();
    }
    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 $allowed_binaries = q[(?:]
      . ( join q[|], map { quotemeta } @{ $options{'allow-binary'} } ) . q[)];
    my $allowed_binary_regex = qr/$allowed_binaries/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/"$allowed_binary_regex"[ ]\-\-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/"$allowed_binary_regex"$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);
        if ( $options{'force-binary'} ) {
            $command_and_arguments =~
              s/^"$allowed_binary_regex"/"$options{'force-binary'}"/smx;
        }
        Sys::Syslog::openlog( $ident, 'cons', $options{facility} );
        Sys::Syslog::syslog( Sys::Syslog::LOG_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( Sys::Syslog::LOG_ERR(), $eval_error );
    Sys::Syslog::closelog();
    warn "$eval_error\n";
    exit 1;
};

