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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
#!/usr/local/bin/perl
# $Xorg: xload,v 1.3 2000/08/17 19:54:57 cpqbld Exp $
# CGI script to launch xload
#
# define every program we are going to use
$project_root = "XPROJECT_ROOT";
$command = $project_root . "/bin/xload -update 1";
$xfindproxy = $project_root . "/bin/xfindproxy";
$xauth = $project_root . "/bin/xauth";
# address of our proxy manager
$proxymngr = "XPROXYMNGR";
# make stderr and stdout unbuffered so nothing get lost
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
# print out header to content httpd no matter what happens later on
print "Content-type: text/plain\r\n\r\n";
# let's try not to leave any file behind us if things go really wrong
sub handler { # 1st argument is signal name
local($sig) = @_;
# send error code first and error msg then
print "1\n";
print "Error: Caught a SIG$sig -- Oops!\n";
system "rm -f /tmp/*$$";
exit(0);
}
$SIG{'INT'} = 'handler';
$SIG{'QUIT'} = 'handler';
$SIG{'TERM'} = 'handler';
$SIG{'KILL'} = 'handler';
$SIG{'STOP'} = 'handler';
# this one is perhaps the most important one, since this is what we should get
# when the user interrupts the GET request.
$SIG{'PIPE'} = 'handler';
######################
# sub procedures
######################
# parse an url param of the form: proto:display[;param]
sub parse_url {
local($input, *proto_ret, *display_ret, *param_ret) = @_;
# extract param first
($sub_url, $param_ret) = split(/;/, $input, 2);
# then extract proto and display
($proto_ret, $display_ret) = split(/:/, $sub_url, 2);
}
# parse an auth param of the form: auth=name:key
sub parse_auth {
local($input, *name_ret, *key_ret) = @_;
if ($input) {
($param_name, $param_value) = split(/=/, $input, 2);
if ($param_name eq "auth") {
($name_ret, $key_ret) = split(/:/, $param_value, 2);
}
}
}
# parse an LBX param of the form: either NO or YES[;auth=...]
sub parse_lbx_param {
local($input, *lbx_ret, *lbx_auth_name_ret, *lbx_auth_key_ret) = @_;
($lbx_ret, $lbxparam) = split(/;/, $input, 2);
if ($lbx_ret eq "YES") {
# look for an authentication auth in param
&parse_auth($lbxparam, *lbx_auth_name_ret, *lbx_auth_key_ret);
}
}
# setup proxy with possible auth, change display parameter when succeeding
sub setup_lbx_proxy {
local(*display, $auth_name, $auth_key) = @_;
# setup auth file for xfindproxy
if ($auth_name && $auth_key) {
$proxy_input = "/tmp/xlbxauth.$$";
open(PROXYINPUT, ">$proxy_input");
print PROXYINPUT "$auth_name\n$auth_key\n";
close(PROXYINPUT);
$findproxy_param = " -auth <$proxy_input";
} else {
$findproxy_param = "";
}
# remove screen number specification if there is one
($host, $tmp) = split(/:/, $display);
($dpy, $screen) = split(/\./, $tmp);
$server = $host . ":" . $dpy;
# let's get an LBX proxy
open(PROXY, "$xfindproxy -manager $proxymngr -server $server -name LBX $findproxy_param|");
# get the proxy address from xfindproxy output
while (<PROXY>) {
chop;
($proxy_dpy, $proxy_port) = split(/:/, $_);
if ($proxy_dpy && $proxy_port) {
# build up the new display name
$display = $proxy_dpy . ":" . $proxy_port;
if ($screen) {
$display .= "." . $screen;
}
last;
}
}
close(PROXY);
if ($proxy_input) {
system "rm -f $proxy_input";
}
}
# add entry in authority file
sub add_auth {
local($display, $auth_name, $auth_key) = @_;
system "$xauth add $display $auth_name $auth_key";
}
######################
# the main thing now
######################
# handle both ways of getting query
if ($ENV{'QUERY_STRING'})
{
$query = $ENV{'QUERY_STRING'};
} else {
$query = $ARGV[0];
}
if ($query)
{
$cleanup = "";
# parse params
%params = split(/\?/, $query);
foreach $param (split(/\?/, $query)) {
($name, $value) = split(/=/, $param, 2);
if ($name eq "WIDTH") {
$width = $value;
} elsif ($name eq "HEIGHT") {
$height = $value;
} elsif ($name eq "UI") {
# look at what we got for the UI parameter, it should be of the
# form: x11:hostname:dpynum[.screen][;auth=...]
&parse_url($value, *proto, *display, *ui_param);
if ($proto eq 'x11') {
$xdisplay = $display;
} else {
# unknown UI protocol!!
}
# look for an authentication auth in param
&parse_auth($ui_param, *xui_auth_name, *xui_auth_key);
} elsif ($name eq "X-UI-LBX") {
&parse_lbx_param($value, *xui_lbx,
*xui_lbx_auth_name, *xui_lbx_auth_key);
}
}
# set authority file for X
$ENV{'XAUTHORITY'} = "/tmp/xauth.$$";
# and define its related cleanup command
$cleanup = "rm -f $ENV{'XAUTHORITY'}";
# process params
if ($xdisplay) {
if ($xui_lbx eq "YES") {
&setup_lbx_proxy(*xdisplay, $xui_lbx_auth_name, $xui_lbx_auth_key);
}
if ($xui_auth_name && $xui_auth_key) {
&add_auth($xdisplay, $xui_auth_name, $xui_auth_key);
}
# add display specification to the command line
$command .= " -display $xdisplay";
# and put it in the environment too for good measure.
$ENV{'DISPLAY'} = $xdisplay;
}
if ($width && $height) {
# add geometry specification to the command line
$command .= " -geometry ${width}x${height}";
}
# Start application followed by a cleanup command in the background.
# The ouput and input need to be redirected, otherwise the CGI process will
# be kept alive by the http server and the browser will keep waiting for
# the end of the stream...
# Catching application's failure is not easy since we want to run it in
# background and therefore we can't get its exit status. However, we can
# catch obvious errors by logging its output and after some time looking
# at whether the application is still running or not. This is determine
# based on some kind of "lock" file.
# This is quite complicated but it allows to get some error report without
# leaving any file behind us in any case.
$LOCK= "/tmp/lock.$$";
$LOG= "/tmp/log.$$";
$LOG2 = "/tmp/log2.$$";
system "(touch $LOCK; _s=true; $command >$LOG 2>&1 || _s=false; if \$_s; then rm $LOG; else rm $LOCK; fi; if [ -f $LOG2 ]; then rm $LOG2; fi; $cleanup) >/dev/null 2>&1 </dev/null &";
# sleep for a while to let the application start or fail
# it's up to you to decide how long it could for the application to fail...
sleep(5);
# now lets see if the application died
if (open(LOCK, "<$LOCK")) {
close(LOCK);
# the application seems to be running, remove lock and rename the log
# so that it gets removed no matter how the application exits later on
system "rm $LOCK; mv $LOG $LOG2";
# send success error code as reply
print "0\n";
} else {
# the lock file is gone, for sure the application has failed so send
# back error code and log
print "1\n";
system "cat $LOG; rm $LOG";
}
} else {
# reply with an error message
print "This script requires to be given the proper RX arguments
to run successfully.
";
}
|
