]>
Commit | Line | Data |
---|---|---|
dcf3d43b DC |
1 | package PVE::CLI::termproxy; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use PVE::RPCEnvironment; | |
7 | use PVE::CLIHandler; | |
8 | use PVE::JSONSchema qw(get_standard_option); | |
dcf3d43b | 9 | use PVE::PTY; |
5e91985c | 10 | use LWP::UserAgent; |
dcf3d43b DC |
11 | use IO::Select; |
12 | use IO::Socket::IP; | |
13 | ||
14 | use base qw(PVE::CLIHandler); | |
15 | ||
16 | use constant MAX_QUEUE_LEN => 16*1024; | |
5e91985c DC |
17 | use constant DEFAULT_PATH => '/'; |
18 | use constant DEFAULT_PERM => 'Sys.Console'; | |
dcf3d43b DC |
19 | |
20 | sub setup_environment { | |
21 | PVE::RPCEnvironment->setup_default_cli_env(); | |
22 | } | |
23 | ||
5e91985c DC |
24 | sub verify_ticket { |
25 | my ($ticket, $user, $path, $perm) = @_; | |
26 | ||
27 | my $ua = LWP::UserAgent->new(); | |
28 | ||
29 | my $res = $ua->post ('http://localhost:85/api2/json/access/ticket', Content => { | |
30 | username => $user, | |
31 | password => $ticket, | |
32 | path => $path, | |
33 | privs => $perm, }); | |
34 | ||
35 | if (!$res->is_success) { | |
36 | die "Authentication failed: '$res->status_line'\n"; | |
37 | } | |
38 | } | |
39 | ||
dcf3d43b | 40 | sub listen_and_authenticate { |
5e91985c | 41 | my ($port, $timeout, $path, $perm) = @_; |
dcf3d43b DC |
42 | |
43 | my $params = { | |
44 | Listen => 1, | |
45 | ReuseAddr => 1, | |
46 | Proto => &Socket::IPPROTO_TCP, | |
47 | GetAddrInfoFlags => 0, | |
48 | LocalAddr => 'localhost', | |
49 | LocalPort => $port, | |
50 | }; | |
51 | ||
52 | my $socket = IO::Socket::IP->new(%$params) or die "failed to open socket: $!\n"; | |
53 | ||
54 | alarm 0; | |
55 | local $SIG{ALRM} = sub { die "timed out waiting for client\n" }; | |
56 | alarm $timeout; | |
57 | my $client = $socket->accept; # Wait for a client | |
58 | alarm 0; | |
59 | close($socket); | |
60 | ||
61 | my $queue; | |
62 | my $n = sysread($client, $queue, 4096); | |
5e91985c | 63 | if ($n && $queue =~ s/^([^:]+):(.+)\n//) { |
dcf3d43b | 64 | my $user = $1; |
5e91985c | 65 | my $ticket = $2; |
dcf3d43b | 66 | |
5e91985c | 67 | verify_ticket($ticket, $user, $path, $perm); |
dcf3d43b DC |
68 | |
69 | die "aknowledge failed\n" | |
70 | if !syswrite($client, "OK"); | |
71 | ||
72 | } else { | |
73 | die "malformed authentication string\n"; | |
74 | } | |
75 | ||
76 | return ($queue, $client); | |
77 | } | |
78 | ||
79 | sub run_pty { | |
80 | my ($cmd, $webhandle, $queue) = @_; | |
81 | ||
82 | foreach my $k (keys %ENV) { | |
83 | next if $k eq 'PATH' || $k eq 'USER' || $k eq 'HOME' || $k eq 'LANG' || $k eq 'LANGUAGE'; | |
84 | next if $k =~ m/^LC_/; | |
85 | delete $ENV{$k}; | |
86 | } | |
87 | ||
88 | $ENV{TERM} = 'xterm-256color'; | |
89 | ||
90 | my $pty = PVE::PTY->new(); | |
91 | ||
92 | my $pid = fork(); | |
93 | die "fork: $!\n" if !defined($pid); | |
94 | if (!$pid) { | |
95 | $pty->make_controlling_terminal(); | |
96 | exec {$cmd->[0]} @$cmd | |
97 | or POSIX::_exit(1); | |
98 | } | |
99 | ||
100 | $pty->set_size(80,20); | |
101 | ||
102 | read_write_loop($webhandle, $pty->master, $queue, $pty); | |
103 | ||
104 | $pty->close(); | |
105 | waitpid($pid,0); | |
106 | exit(0); | |
107 | } | |
108 | ||
109 | sub read_write_loop { | |
110 | my ($webhandle, $cmdhandle, $queue, $pty) = @_; | |
111 | ||
112 | my $select = new IO::Select; | |
113 | ||
114 | $select->add($webhandle); | |
115 | $select->add($cmdhandle); | |
116 | ||
117 | my @handles; | |
118 | ||
119 | # we may have already messages from the first read | |
b11c02be | 120 | $queue = process_queue($queue, $cmdhandle, $pty); |
dcf3d43b DC |
121 | |
122 | my $timeout = 5*60; | |
123 | ||
124 | while($select->count && scalar(@handles = $select->can_read($timeout))) { | |
125 | foreach my $h (@handles) { | |
126 | my $buf; | |
127 | my $n = $h->sysread($buf, 4096); | |
128 | ||
129 | if ($h == $webhandle) { | |
130 | if ($n && (length($queue) + $n) < MAX_QUEUE_LEN) { | |
131 | $queue = process_queue($queue.$buf, $cmdhandle, $pty); | |
132 | } else { | |
133 | return; | |
134 | } | |
135 | } elsif ($h == $cmdhandle) { | |
136 | if ($n) { | |
137 | syswrite($webhandle, $buf); | |
138 | } else { | |
139 | return; | |
140 | } | |
141 | } | |
142 | } | |
143 | } | |
144 | } | |
145 | ||
146 | sub process_queue { | |
147 | my ($queue, $handle, $pty) = @_; | |
148 | ||
149 | my $msg; | |
150 | while(length($queue)) { | |
151 | ($queue, $msg) = remove_message($queue, $pty); | |
152 | last if !defined($msg); | |
153 | syswrite($handle, $msg); | |
154 | } | |
155 | return $queue; | |
156 | } | |
157 | ||
158 | ||
159 | # we try to remove a whole message | |
160 | # if we succeed, we return the remaining queue and the msg | |
161 | # if we fail, the message is undef and the queue is not changed | |
162 | sub remove_message { | |
163 | my ($queue, $pty) = @_; | |
164 | ||
165 | my $msg; | |
166 | my $type = substr $queue, 0, 1; | |
167 | ||
168 | if ($type eq '0') { | |
169 | # normal message | |
170 | my ($length) = $queue =~ m/^0:(\d+):/; | |
171 | my $begin = 3 + length($length); | |
172 | if (defined($length) && length($queue) >= ($length + $begin)) { | |
173 | $msg = substr $queue, $begin, $length; | |
174 | if (defined($msg)) { | |
175 | # msg contains now $length chars after 0:$length: | |
176 | $queue = substr $queue, $begin + $length; | |
177 | } | |
178 | } | |
179 | } elsif ($type eq '1') { | |
180 | # resize message | |
181 | my ($cols, $rows) = $queue =~ m/^1:(\d+):(\d+):/; | |
182 | if (defined($cols) && defined($rows)) { | |
183 | $queue = substr $queue, (length($cols) + length ($rows) + 4); | |
184 | eval { $pty->set_size($cols, $rows) if defined($pty) }; | |
185 | warn $@ if $@; | |
186 | $msg = ""; | |
187 | } | |
188 | } elsif ($type eq '2') { | |
189 | # ping | |
190 | $queue = substr $queue, 1; | |
191 | $msg = ""; | |
192 | } else { | |
193 | # ignore other input | |
194 | $queue = substr $queue, 1; | |
195 | $msg = ""; | |
196 | } | |
197 | ||
198 | return ($queue, $msg); | |
199 | } | |
200 | ||
201 | __PACKAGE__->register_method ({ | |
202 | name => 'exec', | |
203 | path => 'exec', | |
204 | method => 'POST', | |
205 | description => "Connects a TCP Socket with a commandline", | |
206 | parameters => { | |
207 | additionalProperties => 0, | |
208 | properties => { | |
209 | port => { | |
210 | type => 'integer', | |
211 | description => "The port to listen on." | |
212 | }, | |
5e91985c DC |
213 | path => { |
214 | type => 'string', | |
215 | description => "The Authentication path. (default: '".DEFAULT_PATH."')", | |
216 | default => DEFAULT_PATH, | |
217 | }, | |
218 | perm => { | |
219 | type => 'string', | |
220 | description => "The Authentication Permission. (default: '".DEFAULT_PERM."')", | |
221 | default => DEFAULT_PERM, | |
222 | }, | |
dcf3d43b DC |
223 | 'extra-args' => get_standard_option('extra-args'), |
224 | }, | |
225 | }, | |
226 | returns => { type => 'null'}, | |
227 | code => sub { | |
228 | my ($param) = @_; | |
229 | ||
230 | my $cmd; | |
231 | if (defined($param->{'extra-args'})) { | |
232 | $cmd = [@{$param->{'extra-args'}}]; | |
233 | } else { | |
234 | die "No command given\n"; | |
235 | } | |
236 | ||
5e91985c DC |
237 | my $path = $param->{path} // DEFAULT_PATH; |
238 | my $perm = $param->{perm} // DEFAULT_PERM; | |
239 | my ($queue, $handle) = listen_and_authenticate($param->{port}, 10, $path, $perm); | |
dcf3d43b DC |
240 | |
241 | run_pty($cmd, $handle, $queue); | |
242 | ||
243 | return undef; | |
244 | }}); | |
245 | ||
246 | our $cmddef = [ __PACKAGE__, 'exec', ['port', 'extra-args' ]]; | |
247 | ||
248 | 1; |