#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use Net::OpenSSH::ShellQuoter;
use lib './t';
use common;

if ($^O =~ /MSWin/) {
    plan skip_all => 'Core functionality does not work on Windows';
}

my $alt_lang;
if ($^O =~ /^solaris/ and $ENV{LANG} =~ /\.UTF-8$/) {
    $alt_lang = $ENV{LANG};
    $alt_lang =~ s/\.UTF-8$//;
}

# use Data::Dumper;
sub capture;
sub hexdump;
sub perldump;
sub try_shell;

plan skip_all => 'Your shell does unexpected things!'
    unless shell_is_clean;

my $N = 200;

my @shells = grep try_shell($_), qw(sh csh bash tcsh ksh dash ash pdksh mksh zsh fish);
my %quoter = map { $_ => Net::OpenSSH::ShellQuoter->quoter($_) } @shells;

my @chars = ([grep /\W/, map chr, 1..130],
             [map chr, 1..130],
             [map chr, 1..130, 141..172, 141..172]);
#my @chars = grep /\w/, map chr, 1..130;

my @str = map { my $chars = $chars[rand @chars]; join('', map $chars->[rand(@$chars)], 0..rand(500)) } 1..$N;
push @str, ("\x0a","\x27");

my $broken_ksh = "\x82\x27\x3c\x7e\x7b";
push @str, $broken_ksh;

plan tests => @str * @shells;

diag "running tests for shells @shells";
for my $shell (@shells) {

    # workaround for solaris csh fixing invalid UTF8 sequences.
    local $ENV{LANG} = $alt_lang if $shell eq 'csh' and defined $alt_lang;

    my $i = 0;
    for my $str (@str) {
        my $cmd = join ' ', map $quoter{$shell}->quote($_), "printf", "%s", $str;
        my $out = capture($shell, '-c', $cmd);
        is ($out, $str, "$shell - $i") or do {
            diag "str: >$str< cmd: >$cmd<";
            hexdump "string", $str;
            hexdump "output (shell: $shell)", $out;
            hexdump "quoted", $cmd;
            perldump "string", $str;
        };
        $i++;
    }
}

our $child_pid;
sub capture {
    no warnings 'io';
    my $pid = open my $fh, '-|', @_ or die "unable to exec @_";
    local $/;
    my $out = do {
        local $child_pid = $pid;
        <$fh>
    };
    close $fh;
    $out;
}

sub try_shell {
    my $shell = shift;
    my $ok;
    local $SIG{ALRM} = sub {
        kill KILL => $child_pid if $child_pid;
        die "timeout while waiting for shell $shell"
    };
    eval {
        eval {
            no warnings 'uninitialized';
            alarm 10;
            my $out = capture($shell, '-c', 'echo good');
            $out =~ /^good$/ or die "shell $shell not found";
            if ($shell =~ /ksh/) {
                my $version = `$shell --version 2>&1 </dev/null`;
                $version =~ /version\s+sh\s+\(AT\&T\s+Research\)/
                    and die "Skipping tests for broken AT&T ksh shell";
            }
            elsif ($shell =~ /csh/ and $^O =~ /^aix/) {
                die "Skipping tests for broken AIX csh shell";
            }
            elsif ($shell eq '!!fish') {
                die "TODO: add support for fish shell";
            }
        };
        alarm 0;
        die $@ if $@;
        $ok = 1;
    };
    if ($@) {
        $@ =~ s/ at .*//m;
        diag $@;
    }
    $ok;
}

my $badfh;
sub badfh {
    unless ($badfh) {
        open $badfh, '>', "misquoted.txt" or return;
        print $badfh "This file contains the strings that were not quoted properly\n\n";
    }
    $badfh;
}

sub hexdump {
    no warnings qw(uninitialized);
    my $head = shift;
    my $data = shift;
    my $fh = badfh();
    print $fh "$head:\n";
    while ($data =~ /(.{1,32})/smg) {
        my $line=$1;
        my @c= (( map { sprintf "%02x",$_ } unpack('C*', $line)),
                (("  ") x 32))[0..31];
        $line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;
        print $fh "#> ", join(" ", @c, '|', $line), "\n";
    }
}

sub perldump {
    my $head = shift;
    my $data = shift;
    my $fh = badfh();
    my @c;
    for (split //, $data) {
        if (/[\w!#%&'()*+,\-.\/:;<=>?\[\]^`{|}~]/) {
            push @c, $_;
        }
        elsif (/["\$\@\\]/) {
            push @c, "\\$_";
        }
        else {
            push @c, sprintf "\\x%02x", ord $_;
        }
    }
    print $fh "$head: \"", @c, "\"\n";
}