view release on metacpan or  search on metacpan

ssh-auth-cmd-marionette  view on Meta::CPAN

                chomp $EVAL_ERROR;
                Sys::Syslog::openlog( $ident, 'cons', $parameters{facility} );
                Sys::Syslog::syslog( Sys::Syslog::LOG_ERR(), $EVAL_ERROR );
                Sys::Syslog::closelog();
            };
            exit 1;
        }
        else {
            die "Failed to fork:$EXTENDED_OS_ERROR\n";
        }
    }
    return $regex;
}

eval {
    Getopt::Long::GetOptions(
        \%options,                          'help',
        'version',                          'facility:s',
        'allow-binary:s@',                  'force-binary:s',
        'regex-allow-binary-directories:s', 'regex-allow-binary-paths:s',
        'regex-allow-binary:s',             'scp-only',
    );
    if ( $options{help} ) {
        require Pod::Simple::Text;
        my $parser = Pod::Simple::Text->new();
        $parser->parse_from_file($PROGRAM_NAME);
        exit 0;
    }
    elsif ( $options{version} ) {
        print "$VERSION\n"
          or die "Failed to print to STDOUT:$EXTENDED_OS_ERROR\n";
        exit 0;
    }
    my $tmp_directory_regex = _tmp_directory_regex(%options);
    my $tmp_directory       = $ENV{TMPDIR} || '/tmp';
    $tmp_directory =~ s/\/$//smx;    # remove trailing / for darwin
    my $root_dir_regex;
    my $quoted_tmp_directory = quotemeta $tmp_directory;
    if ( $tmp_directory =~
s/^(${tmp_directory_regex}\/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/${$tmp_directory_regex}\/firefox_marionette_remote\w+/smx;
    }
    %options = _validate_parameters(%options);
    my ( $allowed_binary_directories_regex,
        $allowed_binary_paths_regex, $allowed_binary_regex )
      = _filesystem_regexes(%options);
    my $sub_directory_regex = qr/(?:profile|downloads|tmp|addons|certs)/smx;
    my $profile_names       = q[(?:] . (
        join q[|],
        map { quotemeta } (
            qw(
              bookmarks.html
              prefs.js
              mimeTypes.rdf
              search.json.mozlz4
            )
        )
    ) . q[)];
    my $profile_file_regex    = qr/profile\/$profile_names/smx;
    my $file_regex            = qr/[+\w\-()]{1,255}(?:[.][+\w\-()]{1,255})*/smx;
    my $downloads_regex       = qr/downloads\/$file_regex/smx;
    my $addons_regex          = qr/(?:addons|profile)\/$file_regex/smx;
    my $ca_name_regex         = qr/Firefox::Marionette[ ]Root[ ]CA/smx;
    my $version_updates_regex = q[(?:]
      . (
        join q[|], qr/active\-update[.]xml/smx, qr/application[.]ini/smx,
        qr/updates\/\d+\/update[.]status/smx
      ) . q[)];
    my $xvfb_regex =
      qr/xvfb\-run[ ]\-a[ ]\-s[ ]"-screen[ ]0[ ]\d+x\d+x\d+"[ ]/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/(?:[ ]\-remote\-allow\-system\-access)?/smx,
      qr/(?:[ ]\-width[ ]\d{1,8})?/smx,
      qr/(?:[ ]\-height[ ]\d{1,8})?/smx,
      qr/(?:[ ]\-\-jsconsole)?/smx,
      qr/(?:[ ]\-MOZ_LOG=[[:alnum:],:]+)?/smx,
      qr/(?:[ ]-safe\-mode)?/smx,
      qr/(?:[ ]\-headless)?/smx,
      qr/[ ](?:\-profile[ ]$root_dir_regex\/profile|\-P[ ][[:alnum:]]+)/smx,
      qr/(?:[ ]\-\-no\-remote)?/smx,
      qr/(?:[ ]\-\-new\-instance)?/smx,
      qr/(?:[ ]\-\-devtools)?/smx,
      qr/(?:[ ]\-\-kiosk)?/smx;
    my $prefs_grep_patterns_regex = join q[],
      qr/\-e[ ]marionette[ ]/smx,
      qr/\-e[ ]security[ ]/smx;
    my @darwin_regexes;

    if ( $OSNAME eq 'darwin' ) {
        my $plist_prefix_regex =
          _get_plist_prefix_regex( @{ $options{'allow-binary'} } );
        @darwin_regexes = (
            qr/ls[ ]-1[ ]"$allowed_binary_regex"/smx,
qr/plutil[ ]-convert[ ]json[ ]-o[ ]-[ ]"(?:$plist_prefix_regex)\/Info[.]plist"/smx,
        );
    }

    my @sftp_server_regexs;
    if ( !$options{'scp-only'} ) {
        @sftp_server_regexs = (
            map { qr/${_}[ ]?/smx }
              ( # Adding a space for new sftp-server in Fedora 40 (openssh-9.6p1)
                quotemeta '/usr/libexec/openssh/sftp-server',   # Redhat, Debian
                quotemeta '/usr/libexec/sftp-server',           # FreeBSD
              )
        );
    }
    my $darwin_profile_regex =
      qr/Library\/Application\\[ ]Support\/Firefox\/Profiles/smx;
    my $named_profile_regex =
      qr/(?:[.]mozilla\/firefox|$darwin_profile_regex)/smx;
    my $profile_path_regex =
      qr/(?:$root_dir_regex\/profile|$named_profile_regex\/[[:alnum:].\-]+)/smx;
    my $scp_parameters_regex =
      qr/(?:[ ]\-v)?[ ]\-p[ ]\-[tf][ ](?:-P[ ]\d{2}[ ])?(?:\-v[ ])?/smx;
    my $quoted_linux_profiles_ini = quotemeta q[.mozilla/firefox];
    my $quoted_darwin_profiles_ini =
      quotemeta q[Library/Application Support/Firefox];
    my $profiles_ini_regex =
qr/(?:$quoted_linux_profiles_ini|$quoted_darwin_profiles_ini)\/profiles[.]ini/smx;
    my $allowed_commands_regex = join q[|],
      qr/"$allowed_binary_regex"[ ]\-\-version/smx,
      @darwin_regexes,
      @sftp_server_regexs,
      qr/uname[ ][|][|][ ]ver/smx,
      qr/echo[ ]"TMPDIR=\\"\$TMPDIR\\""/smx,
      qr/echo[ ]"DISPLAY=\\"\$DISPLAY\\""/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$scp_parameters_regex"?$root_dir_regex\/$profile_file_regex"?/smx,
      qr/scp(?:[ ]\-v)?[ ]\-p[ ]\-t[ ]"?$root_dir_regex\/$addons_regex"?/smx,
      qr/scp[ ]\-p[ ]\-t[ ]$root_dir_regex\/certs\/root_ca_\d{1,10}[.]cer/smx,
qr/scp[ ]\-p[ ]\-[fT][ ](?:\-P[ ])?$allowed_binary_directories_regex\/$version_updates_regex/smx,
qr/scp(?:[ ]\-v)?[ ]\-p[ ]\-[tf][ ]"?$root_dir_regex\/$downloads_regex"?/smx,
      qr/scp[ ]\-p[ ]\-[tf][ ]"?$profiles_ini_regex"?/smx,
      qr/kill[ ]\-0[ ]\d{1,8}/smx,
      qr/which[ ]$allowed_binary_regex/smx,
      qr/readlink[ ]\-f[ ]$allowed_binary_paths_regex/smx,
qr/rm[ ]\-Rf[ ]$root_dir_regex(?:[ ]$quoted_tmp_directory\/Temp\-[\d\-a-f]{1,255})*/smx,
qr/ls[ ]-1[ ]"$allowed_binary_directories_regex(?:\/updates(?:\/\d+)?)?"/smx,
      qr/ls[ ]-1[ ]"$root_dir_regex\/downloads"/smx,
      qr/certutil$certutil_arguments_regex/smx,
      qr/(?:$xvfb_regex)?"$allowed_binary_regex"$firefox_arguments_regex/smx,
      qr/grep[ ]$prefs_grep_patterns_regex$profile_path_regex\/prefs[.]js/smx;

    my $user_name = getpwuid $EFFECTIVE_USER_ID;
    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' as '$user_name' from "
              . _origin() );
        Sys::Syslog::closelog();
        exec $command_and_arguments
          or die "Failed to '$command_and_arguments':$EXTENDED_OS_ERROR\n";
    }
    else {
        my $origin = _origin();
        Sys::Syslog::openlog( $ident, 'cons', $options{facility} );
        Sys::Syslog::syslog( Sys::Syslog::LOG_WARNING(),
                'Unrecognisable command "'
              . $ENV{SSH_ORIGINAL_COMMAND}
              . "\" as '$user_name' from $origin with a quoted TMPDIR of \"$quoted_tmp_directory\" and a root directory regex of \"$root_dir_regex\""
        );
        Sys::Syslog::closelog();
    }
    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();
};
exit 1;

sub _validate_parameters {
    my (%parameters) = @_;
    my $facility = $parameters{facility};
    eval { $parameters{facility} = Sys::Syslog->$facility(); } or do {
        my $original = $parameters{facility};
        $parameters{facility} = Sys::Syslog::LOG_LOCAL0();
        Sys::Syslog::openlog( $ident, 'cons', $parameters{facility} );
        Sys::Syslog::syslog( Sys::Syslog::LOG_WARNING(),
            "Failed to parse --facility argument of '$original':$EVAL_ERROR" );
        Sys::Syslog::closelog();
    };
    if ( !defined $ENV{SSH_ORIGINAL_COMMAND} ) {
        die
"$PROGRAM_NAME requires the SSH_ORIGINAL_COMMAND environment variable to be defined\n";
    }
    if ( !defined $parameters{'allow-binary'} ) {
        $parameters{'allow-binary'} = ['firefox'];
        if ( $OSNAME eq 'darwin' ) {
            push @{ $parameters{'allow-binary'} },
              '/Applications/Firefox.app/Contents/MacOS/firefox',
'/Applications/Firefox Developer Edition.app/Contents/MacOS/firefox',
              '/Applications/Firefox Nightly.app/Contents/MacOS/firefox',
              '/Applications/Waterfox Current.app/Contents/MacOS/waterfox';
        }