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
242
243
244
245
246
|
(* Parsing messages from OpenSSH *)
(* Examples.
"tjim@saul.cis.upenn.edu's password: " (to stdout)
"Permission denied, please try again." (to stderr ...)
"tjim@saul.cis.upenn.edu's password: " (... to stdout)
"Permission denied (publickey,gssapi,password,hostbased)." (to stderr)
"The authenticity of host 'saul.cis.upenn.edu (158.130.12.4)' can't be established.
RSA key fingerprint is d1:d8:5e:08:8c:ae:56:15:66:af:4b:55:53:2a:bc:38.
Are you sure you want to continue connecting (yes/no)? " (to stdout)
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ WARNING: REMOTE HOST IDENTIFICATION HAS CHANGED! @
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
IT IS POSSIBLE THAT SOMEONE IS DOING SOMETHING NASTY!
Someone could be eavesdropping on you right now (man-in-the-middle attack)!
It is also possible that the RSA host key has just been changed.
The fingerprint for the RSA key sent by the remote host is
d1:d8:5e:08:8c:ae:56:15:66:af:4b:55:53:2a:bc:38.
Please contact your system administrator.
Add correct host key in /Users/trevor/.ssh/known_hosts to get rid of this message.
Offending key in /Users/trevor/.ssh/known_hosts:22
RSA host key for saul.cis.upenn.edu has changed and you have requested strict checking.
Host key verification failed." (to stderr)
*)
let passwordRx =
Rx.rx ".*assword: "
let authenticityRx =
Rx.rx "The authenticity of host .* continue connecting \\(yes/no\\)\\? "
let password s = Rx.match_string passwordRx s
let authenticity s = Rx.match_string authenticityRx s
(* Create a new process with a new controlling terminal, useful for
SSH password interaction.
*)
(*
let a1 = [|'p';'q';'r';'s';'t';'u';'v';'w';'x';'y';'z';'P';'Q';'R';'S';'T'|]
let a2 = [|'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'a';'b';'c';'d';'e';'f'|]
exception Break of (Unix.file_descr * string) option
let ptyMasterOpen () =
if not(Osx.isMacOSX or Osx.isLinux) then None else
try
(* Adapted from Stevens' Advanced Programming in Unix *)
let x = "/dev/pty--" in
for i = 0 to Array.length a1 do
x.[8] <- a1.(i);
for j = 0 to Array.length a2 do
x.[9] <- a2.(j);
let fdOpt =
try Some(Unix.openfile x [Unix.O_RDWR] 0)
with _ -> None in
match fdOpt with None -> ()
| Some fdMaster ->
x.[5] <- 't';
raise (Break(Some(fdMaster,x)))
done
done;
None
with Break z -> z
let ptySlaveOpen = function
None -> None
| Some(fdMaster,ttySlave) ->
let slave =
try Some (Unix.openfile ttySlave [Unix.O_RDWR] 0o600)
with _ -> None in
(try Unix.close fdMaster with Unix.Unix_error(_,_,_) -> ());
slave
let printTermAttrs fd = (* for debugging *)
let tio = Unix.tcgetattr fd in
let boolPrint name x d =
if x then Printf.printf "%s is ON (%s)\n" name d
else Printf.printf "%s is OFF (%s)\n" name d in
let intPrint name x d =
Printf.printf "%s = %d (%s)\n" name x d in
let charPrint name x d =
Printf.printf "%s = '%c' (%s)\n" name x d in
boolPrint "c_ignbrk" tio.Unix.c_ignbrk "Ignore the break condition.";
boolPrint "c_brkint" tio.Unix.c_brkint "Signal interrupt on break condition.";
boolPrint "c_ignpar" tio.Unix.c_ignpar "Ignore characters with parity errors.";
boolPrint "c_parmrk" tio.Unix.c_parmrk "Mark parity errors.";
boolPrint "c_inpck" tio.Unix.c_inpck "Enable parity check on input.";
boolPrint "c_istrip" tio.Unix.c_istrip "Strip 8th bit on input characters.";
boolPrint "c_inlcr" tio.Unix.c_inlcr "Map NL to CR on input.";
boolPrint "c_igncr" tio.Unix.c_igncr "Ignore CR on input.";
boolPrint "c_icrnl" tio.Unix.c_icrnl "Map CR to NL on input.";
boolPrint "c_ixon" tio.Unix.c_ixon "Recognize XON/XOFF characters on input.";
boolPrint "c_ixoff" tio.Unix.c_ixoff "Emit XON/XOFF chars to control input flow.";
boolPrint "c_opost" tio.Unix.c_opost "Enable output processing.";
intPrint "c_obaud" tio.Unix.c_obaud "Output baud rate (0 means close connection).";
intPrint "c_ibaud" tio.Unix.c_ibaud "Input baud rate.";
intPrint "c_csize" tio.Unix.c_csize "Number of bits per character (5-8).";
intPrint "c_cstopb" tio.Unix.c_cstopb "Number of stop bits (1-2).";
boolPrint "c_cread" tio.Unix.c_cread "Reception is enabled.";
boolPrint "c_parenb" tio.Unix.c_parenb "Enable parity generation and detection.";
boolPrint "c_parodd" tio.Unix.c_parodd "Specify odd parity instead of even.";
boolPrint "c_hupcl" tio.Unix.c_hupcl "Hang up on last close.";
boolPrint "c_clocal" tio.Unix.c_clocal "Ignore modem status lines.";
boolPrint "c_isig" tio.Unix.c_isig "Generate signal on INTR, QUIT, SUSP.";
boolPrint "c_icanon" tio.Unix.c_icanon "Enable canonical processing (line buffering and editing)";
boolPrint "c_noflsh" tio.Unix.c_noflsh "Disable flush after INTR, QUIT, SUSP.";
boolPrint "c_echo" tio.Unix.c_echo "Echo input characters.";
boolPrint "c_echoe" tio.Unix.c_echoe "Echo ERASE (to erase previous character).";
boolPrint "c_echok" tio.Unix.c_echok "Echo KILL (to erase the current line).";
boolPrint "c_echonl" tio.Unix.c_echonl "Echo NL even if c_echo is not set.";
charPrint "c_vintr" tio.Unix.c_vintr "Interrupt character (usually ctrl-C).";
charPrint "c_vquit" tio.Unix.c_vquit "Quit character (usually ctrl-\\).";
charPrint "c_verase" tio.Unix.c_verase "Erase character (usually DEL or ctrl-H).";
charPrint "c_vkill" tio.Unix.c_vkill "Kill line character (usually ctrl-U).";
charPrint "c_veof" tio.Unix.c_veof "End-of-file character (usually ctrl-D).";
charPrint "c_veol" tio.Unix.c_veol "Alternate end-of-line char. (usually none).";
intPrint "c_vmin" tio.Unix.c_vmin "Minimum number of characters to read before the read request is satisfied.";
intPrint "c_vtime" tio.Unix.c_vtime "Maximum read wait (in 0.1s units).";
charPrint "c_vstart" tio.Unix.c_vstart "Start character (usually ctrl-Q).";
charPrint "c_vstop" tio.Unix.c_vstop "Stop character (usually ctrl-S)."
*)
(* Implemented in file pty.c *)
external dumpFd : Unix.file_descr -> int = "%identity"
external setControllingTerminal : Unix.file_descr -> unit =
"setControllingTerminal"
external c_openpty : unit -> Unix.file_descr * Unix.file_descr =
"c_openpty"
let openpty() = try Some (c_openpty ()) with Unix.Unix_error _ -> None
(* Utility functions copied from ocaml's unix.ml because they are not exported :-| *)
let rec safe_dup fd =
let new_fd = Unix.dup fd in
if dumpFd new_fd >= 3 then
new_fd
else begin
let res = safe_dup fd in
Unix.close new_fd;
res
end
let safe_close fd = try Unix.close fd with Unix.Unix_error _ -> ()
let perform_redirections new_stdin new_stdout new_stderr =
let newnewstdin = safe_dup new_stdin in
let newnewstdout = safe_dup new_stdout in
let newnewstderr = safe_dup new_stderr in
safe_close new_stdin;
safe_close new_stdout;
safe_close new_stderr;
Unix.dup2 newnewstdin Unix.stdin; Unix.close newnewstdin;
Unix.dup2 newnewstdout Unix.stdout; Unix.close newnewstdout;
Unix.dup2 newnewstderr Unix.stderr; Unix.close newnewstderr
(* Like Unix.create_process except that we also try to set up a
controlling terminal for the new process. If successful, a file
descriptor for the master end of the controlling terminal is
returned. *)
let create_session cmd args new_stdin new_stdout new_stderr =
match openpty () with
None ->
(None,
Unix.create_process cmd args new_stdin new_stdout new_stderr)
| Some (masterFd, slaveFd) ->
(*
Printf.printf "openpty returns %d--%d\n" (dumpFd fdM) (dumpFd fdS); flush stdout;
Printf.printf "new_stdin=%d, new_stdout=%d, new_stderr=%d\n"
(dumpFd new_stdin) (dumpFd new_stdout) (dumpFd new_stderr) ; flush stdout;
*)
begin match Unix.fork () with
0 ->
begin try
Unix.close masterFd;
ignore (Unix.setsid ());
setControllingTerminal slaveFd;
(* WARNING: SETTING ECHO TO FALSE! *)
let tio = Unix.tcgetattr slaveFd in
tio.Unix.c_echo <- false;
Unix.tcsetattr slaveFd Unix.TCSANOW tio;
perform_redirections new_stdin new_stdout new_stderr;
Unix.execvp cmd args; (* never returns *)
assert false (* to satisfy type checker *)
with _ ->
Printf.eprintf "Some error in create_session child\n";
flush stderr;
exit 127
end
| childPid ->
Unix.close slaveFd;
(Some masterFd, childPid)
end
let rec select a b c d =
try Unix.select a b c d
with Unix.Unix_error(Unix.EINTR,_,_) -> select a b c d
(* Wait until there is input. If there is terminal input s,
return Some s. Otherwise, return None. *)
let rec termInput fdTerm fdInput =
let (ready,_,_) = select [fdTerm;fdInput] [] [] (-1.0) in
if not(Safelist.exists (fun x -> x=fdTerm) ready) then None else
(* there's input waiting on the terminal *)
(* read a line of input *)
let msg =
let n = 1024 in (* Assume length of input from terminal < n *)
let s = String.create n in
let howmany =
let rec loop() =
try Unix.read fdTerm s 0 n
with Unix.Unix_error(Unix.EINTR,_,_) -> loop() in
loop() in
if howmany <= 0 then "" else
String.sub s 0 howmany in
let len = String.length msg in
if len = 0 then None (* the terminal has been closed *)
else if len = 2 && msg.[0] = '\r' && msg.[1] = '\n' then
termInput fdTerm fdInput
else Some msg
let (>>=) = Lwt.bind
(* Read messages from the terminal and use the callback to get an answer *)
let handlePasswordRequests fdTerm callback =
Unix.set_nonblock fdTerm;
let buf = String.create 10000 in
let rec loop () =
Lwt_unix.read fdTerm buf 0 10000 >>= (fun len ->
if len = 0 then
(* The remote end is dead *)
Lwt.return ()
else
let query = String.sub buf 0 len in
if query = "\r\n" then
loop ()
else begin
let response = callback query in
Lwt_unix.write fdTerm
(response ^ "\n") 0 (String.length response + 1)
>>= (fun _ ->
loop ())
end)
in
ignore (loop ())
|
