clroot.ml (9445B)
1 (* Unison file synchronizer: src/clroot.ml *) 2 (* Copyright 1999-2020, Benjamin C. Pierce 3 4 This program is free software: you can redistribute it and/or modify 5 it under the terms of the GNU General Public License as published by 6 the Free Software Foundation, either version 3 of the License, or 7 (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU General Public License for more details. 13 14 You should have received a copy of the GNU General Public License 15 along with this program. If not, see <http://www.gnu.org/licenses/>. 16 *) 17 18 19 (* 20 This file parses the unison command-line arguments that 21 specify replicas. The syntax for replicas is based on that of 22 URI's, described in RFC 2396. They have the following grammar: 23 24 replica ::= [protocol:]//[user@][host][:port][/path] 25 | path 26 27 protocol ::= file 28 | socket 29 | ssh 30 31 user ::= [-_a-zA-Z0-9%@]+ 32 33 host ::= [-_a-zA-Z0-9.]+ 34 | \[ [a-f0-9:.]+ zone? \] IPv6 literals (no future format). 35 | { [^}]+ } For Unix domain sockets only. 36 37 zone ::= %[-_a-zA-Z0-9~%.]+ 38 39 port ::= [0-9]+ 40 41 path is any string that does not begin with protocol: or //. 42 43 *) 44 45 (* Command-line roots *) 46 type clroot = 47 ConnectLocal of 48 string option (* root *) 49 | ConnectByShell of 50 string (* shell = "ssh" *) 51 * string (* name of host *) 52 * string option (* user name to log in as *) 53 * string option (* port *) 54 * string option (* root of replica in host fs *) 55 | ConnectBySocket of 56 string (* name of host *) 57 * string (* port where server should be listening *) 58 * string option (* root of replica in host fs *) 59 60 (* Internal datatypes used in parsing command-line roots *) 61 type protocol = File | Socket | Ssh 62 type uri = protocol (* - a protocol *) 63 * string option (* - an optional user *) 64 * string option (* - an optional host *) 65 * int option (* - an optional port *) 66 * string option (* - an optional path *) 67 68 (* Regular expressions, used in parsing *) 69 let protocolColonSlashSlashRegexp = Str.regexp "[a-zA-Z]+://" 70 let protocolColonRegexp = Str.regexp "[a-zA-Z]+:" 71 let slashSlashRegexp = Str.regexp "//" 72 73 let getProtocolSlashSlash s = 74 if Str.string_match protocolColonSlashSlashRegexp s 0 75 then 76 let matched = Str.matched_string s in 77 let len = String.length matched in 78 let remainder = Str.string_after s len in 79 let protocolName = String.sub matched 0 (len-3) in 80 let protocol = 81 match protocolName with 82 "file" -> File 83 | "rsh" -> 84 raise (Invalid_argument 85 (Printf.sprintf "protocol rsh has been deprecated, use ssh instead (optionally specifying a different sshcmd preference)")) 86 | "socket" -> Socket 87 | "ssh" -> Ssh 88 | "unison" -> 89 raise(Invalid_argument 90 (Printf.sprintf "protocol unison has been deprecated, use file, ssh, or socket instead" )) 91 | _ -> 92 raise(Invalid_argument 93 (Printf.sprintf "\"%s\": unrecognized protocol %s" s protocolName)) in 94 Some(protocol,remainder) 95 else if Str.string_match slashSlashRegexp s 0 96 then Some(File,String.sub s 2 (String.length s - 2)) 97 else if Str.string_match protocolColonRegexp s 0 98 then 99 let matched = Str.matched_string s in 100 match matched with 101 "file:" | "ssh:" | "socket:" -> 102 raise(Util.Fatal 103 (Printf.sprintf 104 "ill-formed root specification \"%s\" (%s must be followed by //)" 105 s matched)) 106 | _ -> None 107 else None 108 109 let userAtRegexp = Str.regexp "[-_a-zA-Z0-9.%@]+@" 110 let getUser s = 111 if Str.string_match userAtRegexp s 0 112 then 113 let userAt = Str.matched_string s in 114 let len = String.length userAt in 115 let afterAt = Str.string_after s len in 116 let beforeAt = String.sub userAt 0 (len-1) in 117 (Some beforeAt,afterAt) 118 else (None,s) 119 120 let ipv6Regexp = "[a-f0-9:.]+\\(%[-_a-zA-Z0-9~%.]+\\)?" 121 (* Hostname, IP or Unix domain socket path *) 122 let hostRegexp = Str.regexp ("[-_a-zA-Z0-9%.]+\\|{[^}]+}\\|\\[\\(" ^ ipv6Regexp ^ "\\)\\]") 123 let getHost s = 124 if Str.string_match hostRegexp s 0 125 then 126 let host = Str.matched_string s in 127 let host' = try Str.matched_group 1 s with Not_found -> host in 128 let s' = Str.string_after s (String.length host) in 129 (Some host', s') 130 else (None,s) 131 132 let colonPortRegexp = Str.regexp ":[^/]+" 133 let getPort s = 134 if Str.string_match colonPortRegexp s 0 135 then 136 let colonPort = Str.matched_string s in 137 let len = String.length colonPort in 138 let port = String.sub colonPort 1 (len-1) in 139 let s' = Str.string_after s len in 140 (Some port,s') 141 else (None,s) 142 143 (* parseUri : string 144 -> protocol 145 * user option 146 * host option 147 * port option 148 * path option 149 150 where user, host, port, and path are strings, 151 and path is guaranteed to be non-empty 152 *) 153 let parseUri s = 154 let s = Util.trimWhitespace s in 155 match getProtocolSlashSlash s with 156 None -> 157 (File,None,None,None,Some s) 158 | Some(protocol,s0) -> 159 let (userOpt,s1) = getUser s0 in 160 let (hostOpt,s2) = getHost s1 in 161 let (portOpt,s3) = getPort s2 in 162 let pathOpt = 163 let len = String.length s3 in 164 if len <= 0 then None 165 else if String.get s3 0 = '/' then 166 if len=1 then None 167 else Some(String.sub s3 1 (len-1)) 168 else 169 raise(Util.Fatal 170 (Printf.sprintf "ill-formed root specification %s" s)) in 171 (protocol,userOpt,hostOpt,portOpt,pathOpt) 172 173 let parseHostPort s = 174 let (hostOpt, s1) = getHost s in 175 let (portOpt, s2) = getPort s1 in 176 if String.length s2 > 0 then 177 raise (Util.Transient 178 (Printf.sprintf "ill-formed host specification %s" s)); 179 ((match hostOpt with Some h -> h | None -> ""), portOpt) 180 181 (* These should succeed *) 182 let t1 = "socket://tjim@saul.cis.upenn.edu:4040/hello/world" 183 let t2 = "ssh://tjim@saul/hello/world" 184 (*let t3 = "rsh://saul:4040/hello/world" 185 let t4 = "rsh://saul/hello/world" 186 let t5 = "rsh://saul" 187 let t6 = "rsh:///hello/world"*) 188 let t7 = "///hello/world" 189 let t8 = "//raptor/usr/local/bin" 190 let t9 = "file://raptor/usr/local/bin" 191 let t9 = "//turtle/c:/winnt/" 192 let t9 = "file://turtle/c:/winnt/" 193 194 (* These should fail *) 195 let b1 = "//saul:40a4/hello" 196 let b2 = "RSH://saul/hello" 197 let b3 = "rsh:/saul/hello" 198 let b4 = "//s%aul/hello" 199 200 let cannotAbbrevFileRx = Rx.rx "(file:|ssh:|socket:).*" 201 let networkNameRx = Rx.rx "//.*" 202 (* Main external printing function *) 203 let clroot2string = function 204 | ConnectLocal None | ConnectLocal (Some "") -> "." 205 | ConnectLocal(Some s) -> 206 if Rx.match_string cannotAbbrevFileRx s 207 then if Rx.match_string networkNameRx s 208 then Printf.sprintf "file:%s" s 209 else Printf.sprintf "file:///%s" s 210 else s 211 | ConnectBySocket(h,p,s) -> 212 let p = if p <> "" then ":" ^ p else p in 213 let h = if String.contains h ':' && h.[0] <> '{' then "[" ^ h ^ "]" else h in 214 Printf.sprintf "socket://%s%s/%s" h p 215 (match s with None -> "" | Some x -> x) 216 | ConnectByShell(sh,h,u,p,s) -> 217 let user = match u with None -> "" | Some x -> x^"@" in 218 let port = match p with None -> "" | Some x -> ":"^x in 219 let path = match s with None -> "" | Some x -> x in 220 let h = if String.contains h ':' then "[" ^ h ^ "]" else h in 221 Printf.sprintf "%s://%s%s%s/%s" sh user h port path 222 223 (* Pref sshversion removed since 2.52 *) 224 let () = Prefs.markRemoved "sshversion" 225 226 let fixHost = function 227 | ConnectLocal _ as r -> r 228 | ConnectBySocket (h, "", s) -> 229 (match parseHostPort h with 230 | h, Some p -> ConnectBySocket (h, p, s) 231 | h, None -> ConnectBySocket (h, "", s)) 232 | ConnectBySocket _ as r -> r 233 | ConnectByShell (sh, h, u, None, s) -> 234 let (h, p) = parseHostPort h in 235 ConnectByShell (sh, h, u, p, s) 236 | ConnectByShell _ as r -> r 237 238 (* Main external function *) 239 let parseRoot string = 240 let illegal2 s = raise(Prefs.IllegalValue 241 (Printf.sprintf 242 "\"%s\": %s" string s)) in 243 let (protocol,user,host,port,path) = parseUri string in 244 let clroot = 245 match protocol,user,host,port with 246 | _,_,None,Some _ 247 | _,Some _,None,None 248 | Socket, _, None, None 249 | Ssh,_,None,_ -> 250 illegal2 "missing host" 251 | File,_,_,Some _ -> 252 illegal2 "ill-formed (cannot use a port number with file)" 253 | File,_,Some h,None -> 254 let prefix = "//"^h^"/" in 255 (match path with 256 None -> ConnectLocal(Some prefix) 257 | Some p -> ConnectLocal(Some(prefix^p))) 258 | File,None,None,None -> 259 ConnectLocal(path) 260 | Socket, None, Some h, Some p when h.[0] <> '{' -> 261 ConnectBySocket(h,p,path) 262 | Socket, None, Some h, None when h.[0] = '{' -> 263 ConnectBySocket (h, "", path) 264 | Socket,Some _,_,_ -> 265 illegal2 "ill-formed (cannot use a user with socket)" 266 | Socket,_,_,None -> 267 illegal2 "ill-formed (must give a port number with socket)" 268 | Socket, _, Some _, Some _ -> 269 illegal2 "ill-formed (must not give a port number with Unix domain socket)" 270 | Ssh,_,Some h,_ -> 271 ConnectByShell("ssh",h,user,port,path) in 272 clroot