File: read-write.t

package info (click to toggle)
libapp-termcast-perl 0.13-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 200 kB
  • ctags: 8
  • sloc: perl: 516; makefile: 2
file content (115 lines) | stat: -rw-r--r-- 3,031 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Requires 'Test::TCP', 'IO::Pty::Easy';

use App::Termcast;

pipe(my $cread, my $swrite);
pipe(my $sread, my $cwrite);

alarm 60;

my $crlf = "\x0d\x0a";

test_tcp(
    client => sub {
        my $port = shift;

        close $swrite;
        close $sread;

        { sysread($cread, my $buf, 1) }

        my $client_script = <<EOF;
        use App::Termcast;

        no warnings 'redefine';
        local *App::Termcast::_termsize = sub { return (80, 24) };
        use warnings 'redefine';

        my \$tc = App::Termcast->new(
            host     => '127.0.0.1',
            port     => $port,
            user     => 'test',
            password => 'tset',
        );
        \$tc->run(\$^X, '-ple', q[sleep 1,last if /^\$/]);
EOF
        my $pty = IO::Pty::Easy->new;
        $pty->spawn($^X, (map {; '-I', $_ } @INC), '-e', $client_script);
        syswrite($cwrite, 'a');
        { sysread($cread, my $buf, 1) }

        $pty->write("foo\n");
        syswrite($cwrite, 'a');
        { sysread($cread, my $buf, 1) }

        is(full_read($pty), "foo${crlf}foo${crlf}");

        $pty->write("bar\n");
        syswrite($cwrite, 'a');
        { sysread($cread, my $buf, 1) }

        is(full_read($pty), "bar${crlf}bar${crlf}");

        $pty->write("\n");
        syswrite($cwrite, 'a');
        { sysread($cread, my $buf, 1) }

        is(full_read($pty), "$crlf");
    },
    server => sub {
        my $port = shift;
        close $cwrite;
        close $cread;
        my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
                                         LocalPort => $port,
                                         Listen    => 1);
        $sock->accept; # signal to the client that the port is available
        syswrite($swrite, 'a');
        my $client = $sock->accept;
        { sysread($sread, my $buf, 1) }
        is(full_read($client),
           "hello test tset\n\e\]499;{\"geometry\":[80,24]}\x07",
           "got the correct login info");
        $client->send("hello, test\n");

        syswrite($swrite, 'a');
        my $total_out = '';
        while (1) {
            { sysread($sread, my $buf, 1) }
            my $output = full_read($client);
            last unless defined($output) && length($output);
            $total_out .= $output;
            syswrite($swrite, 'a');
        }
        is($total_out, "foo${crlf}foo${crlf}bar${crlf}bar${crlf}${crlf}",
           'sent the right data to the server');
        syswrite($swrite, 'a');
        sleep 1 while $client->connected;
    },
);

sub full_read {
    my ($fh) = @_;

    my $select = IO::Select->new($fh);
    return if $select->has_exception(0.1);

    1 while !$select->can_read(1);

    my $ret;
    while ($select->can_read(1)) {
        my $new;
        sysread($fh, $new, 4096);
        last unless defined($new) && length($new);
        $ret .= $new;
        return $ret if $select->has_exception(0.1);
    }

    return $ret;
}

done_testing;