1implement Url; 2 3include "sys.m"; 4 sys: Sys; 5 6include "string.m"; 7 S: String; 8 9include "url.m"; 10 11schemes = array[] of { 12 NOSCHEME => "", 13 HTTP => "http", 14 HTTPS => "https", 15 FTP => "ftp", 16 FILE => "file", 17 GOPHER => "gopher", 18 MAILTO => "mailto", 19 NEWS => "news", 20 NNTP => "nntp", 21 TELNET => "telnet", 22 WAIS => "wais", 23 PROSPERO => "prospero", 24 JAVASCRIPT => "javascript", 25 UNKNOWN => "unknown" 26}; 27 28init() 29{ 30 sys = load Sys Sys->PATH; 31 S = load String String->PATH; 32} 33 34# To allow relative urls, only fill in specified pieces (don't apply defaults) 35# general syntax: <scheme>:<scheme-specific> 36# for IP schemes, <scheme-specific> is 37# //<user>:<passwd>@<host>:<port>/<path>?<query>#<fragment> 38makeurl(surl: string): ref ParsedUrl 39{ 40 scheme := NOSCHEME; 41 user := ""; 42 passwd := ""; 43 host := ""; 44 port := ""; 45 pstart := ""; 46 path := ""; 47 query := ""; 48 frag := ""; 49 50 (sch, url) := split(surl, ":"); 51 if(url == "") { 52 url = sch; 53 sch = ""; 54 } 55 else { 56 (nil, x) := S->splitl(sch, "^-a-zA-Z0-9.+"); 57 if(x != nil) { 58 url = surl; 59 sch = ""; 60 } 61 else { 62 scheme = UNKNOWN; 63 sch = S->tolower(sch); 64 for(i := 0; i < len schemes; i++) 65 if(schemes[i] == sch) { 66 scheme = i; 67 break; 68 } 69 } 70 } 71 if(scheme == MAILTO) 72 path = url; 73 else if (scheme == JAVASCRIPT) 74 path = url; 75 else { 76 if(S->prefix("//", url)) { 77 netloc: string; 78 (netloc, path) = S->splitl(url[2:], "/"); 79 if(path != "") 80 path = path[1:]; 81 pstart = "/"; 82 if(scheme == FILE) 83 host = netloc; 84 else { 85 (up,hp) := split(netloc, "@"); 86 if(hp == "") 87 hp = up; 88 else 89 (user, passwd) = split(up, ":"); 90 (host, port) = split(hp, ":"); 91 } 92 } 93 else { 94 if(S->prefix("/", url)) { 95 pstart = "/"; 96 path = url[1:]; 97 } 98 else 99 path = url; 100 } 101 if(scheme == FILE) { 102 if(host == "") 103 host = "localhost"; 104 } 105 else { 106 (path, frag) = split(path, "#"); 107 (path, query) = split(path, "?"); 108 } 109 } 110 111 return ref ParsedUrl(scheme, 1, user, passwd, host, port, pstart, path, query, frag); 112} 113 114ParsedUrl.tostring(u: self ref ParsedUrl) : string 115{ 116 if (u == nil) 117 return nil; 118 119 ans := ""; 120 if(u.scheme > 0 && u.scheme < len schemes) 121 ans = schemes[u.scheme] + ":"; 122 if(u.host != "") { 123 ans = ans + "//"; 124 if(u.user != "") { 125 ans = ans + u.user; 126 if(u.passwd != "") 127 ans = ans + ":" + u.passwd; 128 ans = ans + "@"; 129 } 130 ans = ans + u.host; 131 if(u.port != "") 132 ans = ans + ":" + u.port; 133 } 134 ans = ans + u.pstart + u.path; 135 if(u.query != "") 136 ans = ans + "?" + u.query; 137 if(u.frag != "") 138 ans = ans + "#" + u.frag; 139 return ans; 140} 141 142ParsedUrl.makeabsolute(u: self ref ParsedUrl, b: ref ParsedUrl) 143{ 144# The following is correct according to RFC 1808, but is violated 145# by various extant web pages. 146 147 if(u.scheme != NOSCHEME && u.scheme != HTTP) 148 return; 149 150 if(u.host == "" && u.path == "" && u.pstart == "" && u.query == "" && u.frag == "") { 151 u.scheme = b.scheme; 152 u.user = b.user; 153 u.passwd = b.passwd; 154 u.host = b.host; 155 u.port = b.port; 156 u.path = b.path; 157 u.pstart = b.pstart; 158 u.query = b.query; 159 u.frag = b.frag; 160 return; 161 } 162 if(u.scheme == NOSCHEME) 163 u.scheme = b.scheme; 164 if(u.host != "") 165 return; 166 u.user = b.user; 167 u.passwd = b.passwd; 168 u.host = b.host; 169 u.port = b.port; 170 if(u.pstart == "/") 171 return; 172 u.pstart = "/"; 173 if(u.path == "") { 174 u.path = b.path; 175 if(u.query == "") 176 u.query = b.query; 177 } 178 else { 179 (p1,nil) := S->splitr(b.path, "/"); 180 u.path = canonize(p1 + u.path); 181 } 182} 183 184# Like splitl, but assume one char match, and omit that from second part. 185# If c doesn't appear in s, the return is (s, ""). 186split(s, c: string) : (string, string) 187{ 188 (a,b) := S->splitl(s, c); 189 if(b != "") 190 b = b[1:]; 191 return (a,b); 192} 193 194# remove ./ and ../ from s 195canonize(s: string): string 196{ 197 (base, file) := S->splitr(s, "/"); 198 (nil, path) := sys->tokenize(base, "/"); 199 revpath : list of string = nil; 200 for(p := path; p != nil; p = tl p) { 201 if(hd p == "..") { 202 if(revpath != nil) 203 revpath = tl revpath; 204 } 205 else if(hd p != ".") 206 revpath = (hd p) :: revpath; 207 } 208 while(revpath != nil && hd revpath == "..") 209 revpath = tl revpath; 210 ans := ""; 211 if(revpath != nil) { 212 ans = hd revpath; 213 revpath = tl revpath; 214 while(revpath != nil) { 215 ans = (hd revpath) + "/" + ans; 216 revpath = tl revpath; 217 } 218 } 219 if (ans != nil) 220 ans += "/"; 221 ans += file; 222 return ans; 223} 224 225