OdClient.Mod 54 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598
  1. (* Aos, Copyright 2003, Edgar Schwarz, ETH Zurich
  2. Authors. Edgar Schwarz
  3. Contents. Clientside methods.
  4. 09-07-31: robin stoll
  5. - put everything into OdClient object
  6. - fixed StoreResult2File, support for missing Content-Length
  7. - open only one TCP connection per object
  8. - added Connection: keep-alive
  9. - added svn dependent procedures/stuff
  10. *)
  11. MODULE OdClient; (** AUTHOR "TF"; PURPOSE "HTTP client"; *)
  12. IMPORT
  13. TCP, Streams, IP, Files, DNS, WebHTTP, Modules, Kernel,
  14. XML, XMLObjects, OdAuthBase, OdXml, OdUtil, Strings, MultiLogger,
  15. Commands;
  16. VAR
  17. log * : OdUtil.Log;
  18. traceLevel * : LONGINT;
  19. CONST
  20. Ok* = 0;
  21. ResCOULDNOTCONNECT* = -1;
  22. ResHOSTNOTFOUND* = -2;
  23. UserAgent = "ObeDAV 0.15";
  24. ShowDebugWindow = FALSE;
  25. CONST (* Tracelevels *)
  26. (* TlNone = 0;*)
  27. TlHeader = 1;
  28. TlBody = 2;
  29. (*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<*)
  30. TYPE
  31. (** This realizes the relation between a serverside version controlled configuration (VCC) and a clientside workspace.
  32. It works also on the members of the VCC to allow easier up and download between client and server.
  33. With a highspeed connection it doesn't matter to upload also unchanged files. So bookkeping on local changes
  34. isn't important.
  35. This isn't quite what is specified for clientside workspaces but should be good enough for a simple process with
  36. no versioning in the local workspace.
  37. DeltaV doesn't define any depth header for CHECKIN, CHECKOUT. So Vcc must get the information from the server
  38. and send requests for single resources.
  39. *)
  40. Vcc * = OBJECT (*POINTER TO RECORD*)
  41. VAR
  42. state: ARRAY 16 OF CHAR;
  43. client : OdClient;
  44. xml : OdXml.OdXml;
  45. PROCEDURE &init* ( c : OdClient );
  46. BEGIN
  47. client := c;
  48. xml := client.xml;
  49. END init;
  50. (* Split at the last '/' at the moment. *)
  51. PROCEDURE SplitConfRes(CONST confRes: ARRAY OF CHAR; VAR conf, res: ARRAY OF CHAR);
  52. CONST CollCh = '/';
  53. VAR len, pos: LONGINT;
  54. BEGIN
  55. len := Strings.Length(confRes);
  56. pos := len - 1;
  57. LOOP
  58. IF (pos < 0) OR (confRes[pos] = CollCh) THEN EXIT; ELSE DEC(pos); END;
  59. END;
  60. IF pos = -1 THEN
  61. COPY("/", conf); COPY(confRes, res);
  62. ELSE
  63. Strings.Copy(confRes, 0, pos+1, conf);
  64. Strings.Copy(confRes, pos+1, len - pos - 1, res);
  65. END;
  66. END SplitConfRes;
  67. (* Get filelist of server discriminated by version state *)
  68. PROCEDURE VersionMembers(CONST remote: ARRAY OF CHAR; VAR all, unversioned, checkedin, checkedout: OdUtil.Lines);
  69. VAR
  70. res: WORD;
  71. resHeader: WebHTTP.ResponseHeader; out : Streams.Reader;
  72. doc: XML.Document; root, response, href, prop: XML.Element;
  73. responses: XMLObjects.Enumerator; p: ANY;
  74. unpaddedRemote: ARRAY 256 OF CHAR;
  75. propNames: WebHTTP.AdditionalField; elName, name, resName, confName: OdUtil.Line;
  76. BEGIN
  77. NEW(all); NEW(unversioned); NEW(checkedin); NEW(checkedout);
  78. ShowMethodUrl(WebHTTP.PropfindM, Url(remote, "")); (* Url of the server directory. *)
  79. propNames := NIL;
  80. WebHTTP.SetAdditionalFieldValue(propNames, "D:displayname", "");
  81. WebHTTP.SetAdditionalFieldValue(propNames, "D:getcontentlength", "");
  82. WebHTTP.SetAdditionalFieldValue(propNames, "D:getlastmodified", "");
  83. WebHTTP.SetAdditionalFieldValue(propNames, "D:resourcetype", "");
  84. WebHTTP.SetAdditionalFieldValue(propNames, "D:checked-in", "");
  85. WebHTTP.SetAdditionalFieldValue(propNames, "D:checked-out", "");
  86. client.Propfind(Url(remote, ""), "1", propNames, resHeader, out, res);
  87. doc := client.XmlResult(resHeader, res, out);
  88. IF doc # NIL THEN
  89. COPY(remote, unpaddedRemote); OdUtil.unpadColl(unpaddedRemote);
  90. (* OdXml.LogDoc("VersionMembers", doc); *)
  91. root := doc.GetRoot(); elName := xml.AbsXmlName(root.GetName());
  92. IF elName = "DAV:multistatus" THEN
  93. responses := root.GetContents();
  94. WHILE responses.HasMoreElements() DO
  95. p := responses.GetNext();
  96. response := p(XML.Element);
  97. IF response # NIL THEN
  98. href := xml.FindElement(response, "DAV:href");
  99. IF href # NIL THEN
  100. OdXml.GetCharData(href, name);
  101. (** ) ls("VersionMembers remote = ", remote); ( **)
  102. (** ) ls("VersionMembers href = ", name); ( **)
  103. IF unpaddedRemote = name THEN (* Configuration collection *)
  104. (* Check for version stuff *)
  105. state := "unversioned";
  106. prop := xml.SplitElement(response, "DAV:propstat.DAV:prop.DAV:checked-in");
  107. IF prop # NIL THEN
  108. state := "checkedin";
  109. ELSE
  110. prop := xml.SplitElement(response, "DAV:propstat.DAV:prop.DAV:checked-out");
  111. IF prop # NIL THEN
  112. state := "checkedout"; (* The collection already is a configuration. *)
  113. END;
  114. END;
  115. ELSE
  116. IF name # "" THEN (* There seems to be a bug leaving a empty named file*)
  117. SplitConfRes(name, confName, resName);
  118. all.add(resName);
  119. prop := xml.SplitElement(response, "DAV:propstat.DAV:prop.DAV:checked-in");
  120. IF prop # NIL THEN
  121. (** ) ls("VersionMembers: checkedin = ", resName); ( **)
  122. checkedin.add(resName);
  123. ELSE
  124. prop := xml.SplitElement(response, "DAV:propstat.DAV:prop.DAV:checked-out");
  125. IF prop # NIL THEN
  126. (** ) ls("VersionMembers: checkedout = ", resName); ( **)
  127. checkedout.add(resName);
  128. ELSE
  129. (** ) ls("VersionMembers: unversioned = ", resName); ( **)
  130. unversioned.add(resName);
  131. END;
  132. END;
  133. END;
  134. END;
  135. END;
  136. END;
  137. END;
  138. END;
  139. END;
  140. IF all = all.next THEN all := NIL; END;
  141. IF checkedin = checkedin.next THEN checkedin := NIL; END;
  142. IF checkedout = checkedout.next THEN checkedout := NIL; END;
  143. IF unversioned = unversioned.next THEN unversioned := NIL; END;
  144. END VersionMembers;
  145. (* Make URL from resource name. A basename at the moment. *)
  146. PROCEDURE Url(CONST remote, resName: ARRAY OF CHAR): OdUtil.Line;
  147. VAR url: OdUtil.Line;
  148. BEGIN
  149. IF resName # "" THEN
  150. Strings.Concat(remote, resName, url);
  151. ELSE
  152. COPY(remote, url);
  153. END;
  154. RETURN url;
  155. END Url;
  156. (* Get filelist of client directory *)
  157. PROCEDURE ClientMembers(CONST dir: ARRAY OF CHAR): OdUtil.Lines;
  158. VAR
  159. enum: Files.Enumerator; time, date, size: LONGINT; entryFlags, flags: SET;
  160. pattern: ARRAY 128 OF CHAR;
  161. fileNames: OdUtil.Lines; name: OdUtil.Line;
  162. BEGIN
  163. Strings.Concat(dir, "*", pattern);
  164. entryFlags := {}; flags := {};
  165. NEW(enum); enum.Open(pattern, flags);
  166. NEW(fileNames);
  167. WHILE enum.GetEntry(name, entryFlags, time, date, size) DO
  168. IF ~ (Files.Directory IN entryFlags) THEN
  169. fileNames.add(name);
  170. END;
  171. END;
  172. IF fileNames = fileNames.next THEN fileNames := NIL; END;
  173. RETURN fileNames;
  174. END ClientMembers;
  175. (* Get resource names. At the moment just the basename of the file. *)
  176. PROCEDURE ClientRes(CONST local: ARRAY OF CHAR): OdUtil.Lines;
  177. VAR res, confRes: OdUtil.Lines; resName, confName: OdUtil.Line;
  178. BEGIN
  179. NEW(res);
  180. confRes := ClientMembers(local);
  181. WHILE confRes # NIL DO
  182. (* ls("confRes = ", confRes.line); *)
  183. SplitConfRes(confRes.line, confName, resName);
  184. (* ls("resName = ", resName); *)
  185. res.add(resName);
  186. confRes := confRes.next;
  187. END;
  188. IF res = res.next THEN res := NIL; END;
  189. RETURN res;
  190. END ClientRes;
  191. (* Make absolute filename from resource name. A basename at the moment. *)
  192. PROCEDURE AbsRes(CONST local, resName: ARRAY OF CHAR): OdUtil.Line;
  193. VAR absRes: OdUtil.Line;
  194. BEGIN
  195. Strings.Concat(local, resName, absRes);
  196. RETURN absRes;
  197. END AbsRes;
  198. (** Put members from client to server workspace. Members which are still on the server but no more
  199. on the client side are removed on the server. *)
  200. PROCEDURE put * (CONST remote, local: ARRAY OF CHAR);
  201. CONST PLog = FALSE;
  202. VAR
  203. toDelete, toPut: OdUtil.Lines;
  204. f: Files.File; in: Files.Reader; out: Streams.Reader;
  205. reqHeader: WebHTTP.RequestHeader; resHeader: WebHTTP.ResponseHeader;
  206. doc: XML.Document; lenStr: ARRAY 16 OF CHAR;
  207. root: XML.Element; s: XML.String;
  208. url, info: ARRAY 128 OF CHAR; rc: WORD;
  209. all, unversioned, checkedin, checkedout: OdUtil.Lines;
  210. BEGIN
  211. toPut := ClientRes(local);
  212. VersionMembers(remote, all, unversioned, checkedin, checkedout);
  213. (* DELETE old members which aren't in new ones. *)
  214. toDelete := toPut.notIn(all);
  215. WHILE toDelete # NIL DO
  216. IF PLog THEN ls("Vcc.put: toDelete.line = ", Url(remote, toDelete.line)); END;
  217. ShowMethodUrl(WebHTTP.DeleteM, Url(remote, toDelete.line));
  218. client.Delete(Url(remote, toDelete.line), resHeader, out, rc);
  219. doc := client.XmlResult(resHeader, rc, out);
  220. IF doc # NIL THEN
  221. LOOP (* *)
  222. root := doc.GetRoot();
  223. s := root.GetName();
  224. IF s^ # "error" THEN
  225. xml.LogDoc("WebDAVClient.Delete: Unexpected root element = ", doc);
  226. EXIT;
  227. END;
  228. OdXml.GetCharData(root, url);
  229. info := "DAV:error = "; Strings.Append(info, url);
  230. log.Enter; log.String(info); log.Exit;
  231. EXIT;
  232. END;
  233. END;
  234. toDelete := toDelete.next;
  235. END;
  236. (* PUT local members. *)
  237. WHILE toPut # NIL DO
  238. f := Files.Old(AbsRes(local, toPut.line));
  239. IF f # NIL THEN
  240. IF PLog THEN ls("Vcc.put: toPut = ", Url(remote, toPut.line)); END;
  241. NEW(in, f, 0);
  242. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Content-Type", "application/octet-stream");
  243. Strings.IntToStr(f.Length(), lenStr);
  244. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Content-Length", lenStr);
  245. ShowMethodUrl(WebHTTP.PutM, Url(remote, toPut.line));
  246. client.Put(Url(remote, toPut.line), reqHeader, resHeader, out, in, rc);
  247. doc := client.XmlResult(resHeader, rc, out);
  248. IF doc # NIL THEN
  249. LOOP (* *)
  250. root := doc.GetRoot();
  251. s := root.GetName();
  252. IF s^ # "error" THEN
  253. xml.LogDoc("WebDAVClient.Checkout: Unexpected root element = ", doc);
  254. EXIT;
  255. END;
  256. OdXml.GetCharData(root, url);
  257. info := "DAV:error = "; Strings.Append(info, url);
  258. log.Enter; log.String(info); log.Exit;
  259. EXIT;
  260. END;
  261. END;
  262. END;
  263. toPut := toPut.next;
  264. END;
  265. END put;
  266. (** Get members from server to client workspace. *)
  267. PROCEDURE get * (CONST remote, local: ARRAY OF CHAR);
  268. VAR
  269. toDelete, all, unversioned, checkedin, checkedout: OdUtil.Lines;
  270. BEGIN
  271. VersionMembers(remote, all, unversioned, checkedin, checkedout);
  272. (* DELETE old members which aren't in new ones. *)
  273. toDelete := all.notIn(ClientMembers(local));
  274. WHILE toDelete # NIL DO
  275. (* Delete(url: ARRAY OF CHAR; VAR con : TCP.Connection;
  276. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  277. *)
  278. toDelete := toDelete.next;
  279. END;
  280. (* GET local members. *)
  281. WHILE all # NIL DO
  282. (* Get*(url : ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader; VAR con : TCP.Connection;
  283. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; in : Streams.Reader; VAR res : WORD);
  284. *)
  285. all := all.next;
  286. END;
  287. END get;
  288. (** Checkin members and then VCC. Subbaselines must be checked in and updated before. If a PUTed resource
  289. isn't different from the old version no new version is created. *)
  290. PROCEDURE checkin * (CONST remote, author, desc: ARRAY OF CHAR);
  291. CONST PLog = TRUE;
  292. VAR
  293. all, unversioned, checkedin, checkedout: OdUtil.Lines;
  294. reqHeader : WebHTTP.RequestHeader; resHeader: WebHTTP.ResponseHeader;
  295. out : Streams.Reader; rc: WORD;
  296. doc: XML.Document; root: XML.Element; info, rootStr: ARRAY 128 OF CHAR; s: XML.String;
  297. props: WebHTTP.AdditionalField;
  298. BEGIN
  299. (* VERSION-CONTROL new server members. CHECKIN existing. *)
  300. VersionMembers(remote, all, unversioned, checkedin, checkedout);
  301. WHILE unversioned # NIL DO
  302. IF PLog THEN ls("Vcc.checkin: toVersionControl = ", unversioned.line); END;
  303. (* TODO: Proppatch desc and author *)
  304. (* Set DAV:comment and DAV:creator-displayname *)
  305. props := NIL;
  306. WebHTTP.SetAdditionalFieldValue(props, "DAV:creator-displayname", author);
  307. WebHTTP.SetAdditionalFieldValue(props, "DAV:comment", desc);
  308. ShowMethodUrl(WebHTTP.ProppatchM, Url(remote, unversioned.line));
  309. client.Proppatch(Url(remote, unversioned.line), "set", props, resHeader, out, rc);
  310. doc := client.XmlResult(resHeader, rc, out); (* Read potential body. *)
  311. IF resHeader.statuscode # WebHTTP.OK THEN
  312. log.Enter; log.String("Vcc.checkin: Proppatch error"); log.Exit;
  313. END;
  314. (* Version Control Freeze *)
  315. ShowMethodUrl(WebHTTP.VersionControlM, Url(remote, unversioned.line));
  316. client.VersionControlFreeze(Url(remote, unversioned.line), reqHeader, resHeader, out, rc);
  317. doc := client.XmlResult(resHeader, rc, out);
  318. IF doc # NIL THEN
  319. xml.LogDoc("XML body not parsed yet", doc);
  320. END;
  321. unversioned := unversioned.next;
  322. END;
  323. (* CHECKIN existing server members. *)
  324. WHILE checkedout # NIL DO
  325. IF PLog THEN ls("Vcc.checkin: checkedout = ", checkedout.line); END;
  326. (* Don't check whether it's checked in. Assume before there was a checkout if necessary. *)
  327. (* Set DAV:comment and DAV:creator-displayname *)
  328. props := NIL;
  329. WebHTTP.SetAdditionalFieldValue(props, "DAV:creator-displayname", author);
  330. WebHTTP.SetAdditionalFieldValue(props, "DAV:comment", desc);
  331. ShowMethodUrl(WebHTTP.ProppatchM, Url(remote, checkedout.line));
  332. client.Proppatch(Url(remote, checkedout.line), "set", props, resHeader, out, rc);
  333. doc := client.XmlResult(resHeader, rc, out); (* Read potential body. *)
  334. IF resHeader.statuscode # WebHTTP.OK THEN
  335. log.Enter; log.String("Vcc.checkin: Proppatch error"); log.Exit;
  336. END;
  337. (* Checkin *)
  338. ShowMethodUrl(WebHTTP.CheckinM, Url(remote, checkedout.line));
  339. client.Checkin(Url(remote, checkedout.line), resHeader, out, rc);
  340. IF doc # NIL THEN
  341. LOOP (* *)
  342. root := doc.GetRoot();
  343. s := root.GetName();
  344. IF s^ # "error" THEN
  345. xml.LogDoc("WebDAVClient.Checkin: Unexpected root element = ", doc);
  346. EXIT;
  347. END;
  348. OdXml.GetCharData(root, rootStr);
  349. info := "DAV:error = "; Strings.Append(info, rootStr);
  350. log.Enter; log.String(info); log.Exit;
  351. EXIT;
  352. END;
  353. END;
  354. checkedout := checkedout.next;
  355. END;
  356. (* Set DAV:comment and DAV:creator-displayname *)
  357. props := NIL;
  358. WebHTTP.SetAdditionalFieldValue(props, "DAV:creator-displayname", author);
  359. WebHTTP.SetAdditionalFieldValue(props, "DAV:comment", desc);
  360. ShowMethodUrl(WebHTTP.ProppatchM, Url(remote, ""));
  361. client.Proppatch(Url(remote, ""), "set", props, resHeader, out, rc);
  362. doc := client.XmlResult(resHeader, rc, out); (* Read potential body. *)
  363. IF resHeader.statuscode # WebHTTP.OK THEN
  364. log.Enter; log.String("Vcc.checkin: Configuration Proppatch error"); log.Exit;
  365. END;
  366. IF state = "unversioned" THEN
  367. (* Baseline-control *)
  368. ShowMethodUrl(WebHTTP.BaselineControlM, Url(remote, ""));
  369. client.BaselineControlFreeze(Url(remote, ""), reqHeader, resHeader, out, rc);
  370. doc := client.XmlResult(resHeader, rc, out);
  371. IF doc # NIL THEN
  372. LOOP (* *)
  373. root := doc.GetRoot();
  374. s := root.GetName();
  375. IF s^ # "error" THEN
  376. xml.LogDoc("WebDAVClient.BaselineControlFreeze: Unexpected root element = ", doc);
  377. EXIT;
  378. END;
  379. OdXml.GetCharData(root, rootStr);
  380. info := "DAV:error = "; Strings.Append(info, rootStr);
  381. log.Enter; log.String(info); log.Exit;
  382. EXIT;
  383. END;
  384. END;
  385. ELSIF state = "checkedout" THEN
  386. (* Checkin *)
  387. ShowMethodUrl(WebHTTP.CheckinM, Url(remote, ""));
  388. client.Checkin(Url(remote, ""), resHeader, out, rc);
  389. doc := client.XmlResult(resHeader, rc, out);
  390. IF doc # NIL THEN
  391. LOOP (* *)
  392. root := doc.GetRoot();
  393. s := root.GetName();
  394. IF s^ # "error" THEN
  395. xml.LogDoc("WebDAVClient.Checkin: Unexpected root element = ", doc);
  396. EXIT;
  397. END;
  398. OdXml.GetCharData(root, rootStr);
  399. info := "DAV:error = "; Strings.Append(info, rootStr);
  400. log.Enter; log.String(info); log.Exit;
  401. EXIT;
  402. END;
  403. END;
  404. ELSE
  405. log.Enter; log.String("WebDAVClient.Vcc.Checkin: unexpected Vcc.state"); log.Exit;
  406. END;
  407. END checkin;
  408. (** Checkout VCC itself and all members. NO subconfigurations. *)
  409. PROCEDURE checkout * (CONST remote: ARRAY OF CHAR);
  410. VAR
  411. resHeader: WebHTTP.ResponseHeader;
  412. out : Streams.Reader; rc: WORD;
  413. doc: XML.Document; root: XML.Element; info, rootStr: ARRAY 128 OF CHAR; elName: OdUtil.Line;
  414. all, unversioned, checkedin, checkedout: OdUtil.Lines;
  415. BEGIN
  416. VersionMembers(remote, all, unversioned, checkedin, checkedout);
  417. IF state = "checkedin" THEN
  418. IF checkedin = NIL THEN NEW(checkedin); END;
  419. checkedin.add(""); (* Checkout VCC. "" will be converted to VCC url. *)
  420. END;
  421. WHILE checkedin # NIL DO
  422. ShowMethodUrl(WebHTTP.CheckoutM, Url(remote, checkedin.line));
  423. client.Checkout(Url(remote, checkedin.line), resHeader, out, rc);
  424. doc := client.XmlResult(resHeader, rc, out);
  425. IF doc # NIL THEN
  426. LOOP (* *)
  427. root := doc.GetRoot();
  428. elName := xml.AbsXmlName(root.GetName());
  429. IF elName # "DAV:error" THEN
  430. xml.LogDoc("WebDAVClient.Checkout: Unexpected root element = ", doc);
  431. EXIT;
  432. END;
  433. OdXml.GetCharData(root, rootStr);
  434. info := "DAV:error = "; Strings.Append(info, rootStr);
  435. log.Enter; log.String(info); log.Exit;
  436. EXIT;
  437. END;
  438. END;
  439. checkedin := checkedin.next;
  440. END;
  441. END checkout;
  442. (** Checkout VCC itself and all members. NO subconfigurations. *)
  443. PROCEDURE uncheckout * (CONST remote: ARRAY OF CHAR);
  444. VAR
  445. reqHeader: WebHTTP.RequestHeader; resHeader: WebHTTP.ResponseHeader;
  446. out : Streams.Reader; rc: WORD;
  447. doc: XML.Document; root: XML.Element; info, rootStr: ARRAY 128 OF CHAR; elName: OdUtil.Line;
  448. all, unversioned, checkedin, checkedout: OdUtil.Lines;
  449. BEGIN
  450. VersionMembers(remote, all, unversioned, checkedin, checkedout);
  451. IF state = "checkedout" THEN
  452. IF checkedout = NIL THEN NEW(checkedout); END;
  453. checkedout.add(""); (* Checkout VCC. "" will be converted to VCC url. *)
  454. END;
  455. WHILE checkedout # NIL DO
  456. ShowMethodUrl(WebHTTP.UncheckoutM, Url(remote, checkedout.line));
  457. client.Uncheckout(Url(remote, checkedout.line), reqHeader, resHeader, out, rc);
  458. doc := client.XmlResult(resHeader, rc, out);
  459. IF doc # NIL THEN
  460. LOOP (* *)
  461. root := doc.GetRoot();
  462. elName := xml.AbsXmlName(root.GetName());
  463. IF elName # "DAV:error" THEN
  464. xml.LogDoc("WebDAVClient.Uncheckout: Unexpected root element = ", doc);
  465. EXIT;
  466. END;
  467. OdXml.GetCharData(root, rootStr);
  468. info := "DAV:error = "; Strings.Append(info, rootStr);
  469. log.Enter; log.String(info); log.Exit;
  470. EXIT;
  471. END;
  472. END;
  473. checkedout := checkedout.next;
  474. END;
  475. END uncheckout;
  476. END Vcc;
  477. TYPE
  478. Repos * = OBJECT (*POINTER TO RECORD*)
  479. VAR
  480. host*, path*: ARRAY 128 OF CHAR;
  481. PROCEDURE &Init*(CONST host, path: ARRAY OF CHAR);
  482. BEGIN COPY(host, SELF.host); COPY(path, SELF.path); END Init;
  483. (** Complete url with prefixed http:// and hostname. *)
  484. PROCEDURE expand * (VAR url: ARRAY OF CHAR);
  485. VAR url0: ARRAY 256 OF CHAR;
  486. BEGIN
  487. IF url[0] = '/' THEN
  488. url0 := "http://"; Strings.Append(url0, host); Strings.Append(url0, url);
  489. COPY(url0, url);
  490. END;
  491. END expand;
  492. END Repos;
  493. TYPE
  494. OdClient* = OBJECT
  495. VAR
  496. repos*: Repos;
  497. basicAuth: ARRAY 64 OF CHAR;
  498. lw: MultiLogger.LogWindow;
  499. l: Streams.Writer;
  500. activity*: ARRAY 256 OF CHAR; (* Rember current activity created by Mkactivity() *)
  501. server*: ARRAY 32 OF CHAR; (* Special servers: svn, .... *)
  502. reqLocation*: ARRAY 256 OF CHAR;(* E.g. for CHECKOUT. *)
  503. xmlInCount: INTEGER;
  504. xml* : OdXml.OdXml;
  505. con : TCP.Connection;
  506. reconnect : BOOLEAN;
  507. actualHost : ARRAY 256 OF CHAR;
  508. actualPort : LONGINT;
  509. PROCEDURE &Init* ( x : OdXml.OdXml );
  510. BEGIN
  511. NEW(repos, "127.0.0.1", "/repos"); (* Default repository. *)
  512. con := NIL;
  513. xml := x;
  514. xmlInCount := 0;
  515. basicAuth := "";
  516. server := "";
  517. reqLocation := "";
  518. reconnect := FALSE;
  519. IF ShowDebugWindow THEN
  520. NEW(lw, "DCT Log", l);
  521. l.String("Started"); l.Ln; l.Update;
  522. log.SetLogWriter(l);
  523. END;
  524. log.SetLogToOut(FALSE);
  525. END Init;
  526. PROCEDURE ParseProps*(doc: XML.Document; VAR propList: WebHTTP.AdditionalField);
  527. VAR
  528. root, response, prop, property, data: XML.Element;
  529. responses, props, datas: XMLObjects.Enumerator;
  530. p: ANY;
  531. s: XML.String;
  532. propertyName, dataName: OdUtil.Line;
  533. dataChars: ARRAY 256 OF CHAR; (* Change to str^ to avoid big array ? *)
  534. BEGIN
  535. root := doc.GetRoot();
  536. IF root # NIL THEN
  537. s := root.GetName();
  538. IF xml.EqualName(s, "DAV:multistatus") THEN
  539. xml.xmlns := NIL;
  540. xml.GetXmlns(root);
  541. responses := root.GetContents();
  542. WHILE responses.HasMoreElements() DO
  543. p := responses.GetNext();
  544. response := p(XML.Element);
  545. IF response # NIL THEN
  546. xml.GetXmlns(response);
  547. (*href := OdXml.FindElement(response, "DAV:href"); OdXml.GetCharData(href, nameData);*)
  548. prop := xml.SplitElement(response, "DAV:propstat.DAV:prop");
  549. IF prop = NIL THEN xml.LogDoc("XML element 'props' not found", doc); RETURN; END;
  550. props := prop.GetContents();
  551. WHILE props.HasMoreElements() DO
  552. p := props.GetNext();
  553. property := p(XML.Element);
  554. propertyName := xml.AbsXmlName(property.GetName());
  555. datas := property.GetContents(); (* Get enumerator. *)
  556. IF datas.HasMoreElements() THEN
  557. p := datas.GetNext();
  558. IF p IS XML.Element THEN
  559. data := p(XML.Element);
  560. dataName := xml.AbsXmlName(data.GetName());
  561. IF dataName = "DAV:href" THEN
  562. OdXml.GetCharData(data, dataChars);
  563. WebHTTP.SetAdditionalFieldValue(propList, propertyName, dataChars);
  564. ELSE (* unexpected stuff *)
  565. OdXml.GetCharData(property, dataChars);
  566. WebHTTP.SetAdditionalFieldValue(propList, propertyName, dataName);
  567. END;
  568. ELSE (* assume it's character data. *)
  569. OdXml.GetCharData(property, dataChars);
  570. WebHTTP.SetAdditionalFieldValue(propList, propertyName, dataChars);
  571. END;
  572. END;
  573. END;
  574. END;
  575. END;
  576. (***
  577. list := propList;
  578. WHILE list # NIL DO
  579. OdUtil.Msg3(list .key, ": ", list.value);
  580. list := list.next;
  581. END;
  582. ***)
  583. ELSE
  584. xml.LogDoc("DAV:multistatus not found", doc);
  585. END
  586. ELSE
  587. log.Enter; log.String("DCT.Propfind: doc.root not found"); log.Exit;
  588. END
  589. END ParseProps;
  590. PROCEDURE XmlResult * (VAR resHeader: WebHTTP.ResponseHeader; res: WORD;
  591. out : Streams.Reader): XML.Document;
  592. CONST
  593. BufSize = 512; XmlInName = "XmlIn0.Log";
  594. VAR
  595. f: Files.File;
  596. scanner: OdXml.Scanner; parser: OdXml.Parser;
  597. doc: XML.Document;
  598. fr: Files.Reader; buf: ARRAY BufSize OF CHAR; read: LONGINT;
  599. xmlInName: ARRAY 16 OF CHAR;
  600. BEGIN
  601. (* Logfilename goes from XmlIn0.Log to XmlIn9.Log. *)
  602. xmlInName := XmlInName; xmlInName[5] := CHR(ORD('0')+xmlInCount); xmlInCount := (xmlInCount+1) MOD 10;
  603. (**) log.Enter; log.String("xmlInName = "); log.String(xmlInName); log.Exit; (**)
  604. (* Store to file and dechunk. *)
  605. StoreResult2File(resHeader, res, out, xmlInName, f);
  606. IF f # NIL THEN
  607. NEW(fr, f, 0);
  608. IF Strings.Pos("text/xml", resHeader.contenttype) > -1 THEN
  609. (** ) log.Enter; log.String("input in file"); log.Exit; ( **)
  610. NEW(scanner, fr); NEW(parser, scanner);
  611. doc := parser.Parse();
  612. (** ) log.Enter; log.String("parsed"); log.Exit; ( **)
  613. IF xml.showTree # NIL THEN
  614. xml.showTree(doc);
  615. END;
  616. RETURN doc;
  617. ELSE
  618. NEW(fr, f, 0);
  619. LOOP
  620. fr.Bytes(buf, 0, BufSize-1, read); buf[read] := 0X;
  621. IF fr.res # Streams.Ok THEN EXIT; log.Enter; log.String("EXIT res"); log.Exit; END;
  622. log.Enter; log.String(buf); log.Exit;
  623. IF read < BufSize-1 THEN EXIT; log.Enter; log.String("EXIT read"); log.Exit; END;
  624. END;
  625. RETURN NIL; (* No XML to parse *)
  626. END;
  627. ELSE
  628. log.Enter; log.String( "xml no content" ); log.Exit;
  629. RETURN NIL;
  630. END;
  631. END XmlResult;
  632. PROCEDURE SvnSetBasicAuth* ( pwd : ARRAY OF CHAR );
  633. VAR
  634. userPass64: ARRAY 64 OF CHAR;
  635. BEGIN
  636. IF pwd = "" THEN
  637. basicAuth := "";
  638. ELSE
  639. OdAuthBase.EncodeString(pwd, userPass64);
  640. basicAuth := "Basic ";
  641. Strings.Append(basicAuth, userPass64);
  642. END;
  643. END SvnSetBasicAuth;
  644. (** Basic authentication means a HTTP header string like:
  645. "Authorization: Basic " Base64(username ":" password) *)
  646. PROCEDURE SetBasicAuth * ( context: Commands.Context );
  647. VAR userPass : ARRAY 64 OF CHAR;
  648. BEGIN
  649. IF context.arg.GetString( userPass ) THEN
  650. SvnSetBasicAuth ( userPass );
  651. ELSE
  652. basicAuth := "";
  653. END;
  654. END SetBasicAuth;
  655. (** Set client trace level to none(0), header(1), body(2) *)
  656. PROCEDURE SetTraceLevel * ( context: Commands.Context );
  657. VAR level: LONGINT;
  658. BEGIN
  659. IF context.arg.GetInteger( level, FALSE ) THEN
  660. CASE level OF
  661. 0..2: traceLevel := level;
  662. ELSE log.String("WebDAVClient.SetTraceLevel (0|1|2)");
  663. END;
  664. ELSE
  665. log.Enter; log.String("WebDAVClient.SetTraceLevel (0|1|2) Current = "); log.Int(traceLevel, 1); log.Exit;
  666. END;
  667. END SetTraceLevel;
  668. (** Set non ObeDAV server. *)
  669. PROCEDURE SetServer * ( context: Commands.Context );
  670. VAR name: ARRAY 32 OF CHAR;
  671. BEGIN
  672. IF context.arg.GetString( name ) THEN
  673. COPY(name, server);
  674. ELSE
  675. log.Enter; log.String("WebDAVClient.SetServer (''|'svn') Current = '"); log.String(server); log.String("'"); log.Exit;
  676. END;
  677. END SetServer;
  678. PROCEDURE SetReqLocation * ( context: Commands.Context );
  679. VAR location: ARRAY 256 OF CHAR;
  680. BEGIN
  681. IF context.arg.GetString( location ) THEN
  682. COPY(location, reqLocation);
  683. ELSE
  684. log.Enter; log.String('WebDAVClient.SetReqLocation ("<location url>"|"")'); log.Exit;
  685. END;
  686. END SetReqLocation;
  687. PROCEDURE SetActivity * ( context: Commands.Context );
  688. VAR url: ARRAY 256 OF CHAR;
  689. BEGIN
  690. IF context.arg.GetString( url ) THEN
  691. COPY(url, activity);
  692. ELSE
  693. log.Enter; log.String('WebDAVClient.SetActivity ("<activity url>"|"")'); log.Exit;
  694. END;
  695. END SetActivity;
  696. PROCEDURE GetRepos* () : Repos;
  697. BEGIN
  698. RETURN repos;
  699. END GetRepos;
  700. PROCEDURE SvnSetRepos * ( CONST url : ARRAY OF CHAR );
  701. VAR
  702. port: LONGINT;
  703. s : ARRAY 6 OF CHAR;
  704. BEGIN
  705. IF ~WebHTTP.SplitHTTPAdr (url, repos.host, repos.path, port) THEN
  706. log.Enter; log.String("WebDAVClient.SetRepos: error."); log.Exit;
  707. ELSE
  708. IF (port # 0) & (port # 80) THEN
  709. Strings.Append ( repos.host, ":" );
  710. Strings.IntToStr ( port, s );
  711. Strings.Append ( repos.host, s );
  712. END;
  713. log.Enter; log.String("WebDAVClient.repos.host="); log.String(repos.host);
  714. log.String(",path="); log.String(repos.path); log.Exit;
  715. END;
  716. END SvnSetRepos;
  717. PROCEDURE SetRepos * ( context: Commands.Context );
  718. VAR url: ARRAY 256 OF CHAR;
  719. BEGIN
  720. IF ~context.arg.GetString( url ) THEN
  721. log.Enter; log.String( "OdClient.SetRepos <repos url> ~" ); log.Exit;
  722. ELSE
  723. SvnSetRepos ( url );
  724. END;
  725. END SetRepos;
  726. PROCEDURE OpenConnection ( CONST url : ARRAY OF CHAR; VAR host, path : ARRAY OF CHAR; VAR port : LONGINT; VAR res : WORD ) : BOOLEAN;
  727. VAR
  728. fadr : IP.Adr;
  729. BEGIN
  730. IF WebHTTP.SplitHTTPAdr(url, host, path, port) THEN
  731. IF path = "" THEN path := "/" END;
  732. IF (con = NIL) OR (con.State() # TCP.Established) OR reconnect OR (actualHost # host) OR (actualPort # port) THEN
  733. COPY ( host, actualHost );
  734. actualPort := port;
  735. NEW(con);
  736. DNS.HostByName(host, fadr, res);
  737. IF res = DNS.Ok THEN
  738. con.KeepAlive(TRUE);
  739. con.Open(TCP.NilPort, fadr, port, res);
  740. IF res = TCP.Ok THEN
  741. reconnect := FALSE;
  742. RETURN TRUE;
  743. ELSE
  744. res := ResCOULDNOTCONNECT;
  745. log.Enter; log.String ( "Could not connect to "); log.String(host); log.Exit;
  746. END;
  747. ELSE
  748. res := ResHOSTNOTFOUND;
  749. log.Enter; log.String("Host "); log.String(host); log.String(" not found : ");log.Exit;
  750. END;
  751. ELSE
  752. RETURN TRUE;
  753. END;
  754. END;
  755. RETURN FALSE;
  756. END OpenConnection;
  757. PROCEDURE CloseConnection*;
  758. BEGIN
  759. IF con # NIL THEN con.Discard END;
  760. END CloseConnection;
  761. (** Generic routine to connect to a server and wait for reply. *)
  762. PROCEDURE Net(CONST url : ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  763. VAR resHeader: WebHTTP.ResponseHeader; xmlReq: XML.Document; VAR out : Streams.Reader; VAR res : WORD);
  764. CONST
  765. StringWriterSize = 10000;
  766. VAR
  767. host : ARRAY 128 OF CHAR; path : ARRAY 256 OF CHAR; xmlSize, port : LONGINT;
  768. w, aosioWriter : Streams.Writer; x : WebHTTP.AdditionalField;
  769. buf: ARRAY StringWriterSize OF CHAR; stringWriter: Streams.StringWriter;
  770. BEGIN
  771. reqHeader.useragent := UserAgent;
  772. (* Cleanup responseHeader in case it's reused *)
  773. resHeader.transferencoding := "";
  774. resHeader.contentlocation := "";
  775. resHeader.contenttype := "";
  776. resHeader.contentlength := -1;
  777. resHeader.additionalFields := NIL;
  778. IF OpenConnection ( url, host, path, port, res ) THEN
  779. IF basicAuth # "" THEN
  780. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Authorization", basicAuth);
  781. END;
  782. IF xmlReq # NIL THEN
  783. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Content-Type", 'text/xml; charset="UTF-8"');
  784. xmlSize := xml.XmlSize(xmlReq); Strings.IntToStr(xmlSize, buf);
  785. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Content-Length", buf);
  786. ELSE
  787. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Content-Length", "0");
  788. END;
  789. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Connection", "Keep-Alive");
  790. (* build request *)
  791. NEW(w, con.Send, 1024);
  792. NEW(out, con.Receive, 1024);
  793. WebHTTP.WriteRequestLine(w, 1, 1, reqHeader.method, path, host);
  794. IF reqHeader.referer # "" THEN w.String("Referer: "); w.String(reqHeader.referer); w.Ln END;
  795. IF reqHeader.useragent # "" THEN w.String("User-Agent: "); w.String(reqHeader.useragent); w.Ln END;
  796. IF reqHeader.accept # "" THEN w.String("Accept: "); w.String(reqHeader.accept); w.Ln END;
  797. IF traceLevel >= TlHeader THEN log.Enter; log.String("Host: "); log.String(host); log.Exit; END;
  798. x := reqHeader.additionalFields;
  799. WHILE x # NIL DO
  800. w.String(x.key); w.String(": "); w.String(x.value); w.Ln;
  801. IF traceLevel >= TlHeader THEN log.Enter; log.String(x.key); log.String(": "); log.String(x.value); log.Exit; END;
  802. x := x.next
  803. END;
  804. w.Ln; (* mark end of header with empty line *)
  805. IF xmlReq # NIL THEN (* send request body. *)
  806. xmlReq.Write(w, NIL, 0);
  807. IF traceLevel >= TlBody THEN
  808. IF xmlSize < StringWriterSize THEN
  809. NEW(stringWriter, StringWriterSize);
  810. aosioWriter := stringWriter; (* Dummy for the compiler. Is compiler correct ? *)
  811. xmlReq.Write(aosioWriter, NIL, 0);
  812. stringWriter.Get(buf);
  813. log.Enter; log.String(buf); log.Exit;
  814. ELSE
  815. log.Enter; log.String("WebDAVClient:Net StringWriterSize too small. Required:"); log.Int(xmlSize,5); log.Exit;
  816. END;
  817. END;
  818. END;
  819. (*w.Char(0X);*) (* Give XML Scanner an EOF *)
  820. w.Update;
  821. (* receive reply *)
  822. ParseReply ( out, resHeader, res );
  823. IF traceLevel >= TlHeader THEN
  824. WebHTTP.LogResponseHeader(log, resHeader); END;
  825. END;
  826. END Net;
  827. PROCEDURE ParseReply ( out : Streams.Reader; VAR resHeader: WebHTTP.ResponseHeader; VAR res : WORD );
  828. VAR
  829. state : ARRAY 50 OF CHAR;
  830. BEGIN
  831. WebHTTP.ParseReply(out, resHeader, res, log);
  832. IF res = WebHTTP.OK THEN res := Ok END;
  833. state := "";
  834. IF WebHTTP.GetAdditionalFieldValue ( resHeader.additionalFields, "Connection", state ) THEN
  835. ELSIF WebHTTP.GetAdditionalFieldValue ( resHeader.additionalFields, "Proxy-Connection", state ) THEN
  836. END;
  837. IF state = "close" THEN
  838. reconnect := TRUE;
  839. END;
  840. END ParseReply;
  841. PROCEDURE BaselineControlFreeze * (CONST url: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  842. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  843. BEGIN (* localServer.freezeInitialConfiguration(conf, log, flags); *)
  844. reqHeader.method := WebHTTP.BaselineControlM;
  845. Net(url, reqHeader, resHeader, NIL, out, res);
  846. END BaselineControlFreeze;
  847. PROCEDURE BaselineControlSelect * (CONST url, baseline: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  848. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  849. VAR
  850. reqBody: OdXml.BaselineControlReq;
  851. host : ARRAY 128 OF CHAR; path : ARRAY 256 OF CHAR; port : LONGINT;
  852. BEGIN
  853. IF WebHTTP.SplitHTTPAdr(url, host, path, port) THEN
  854. reqHeader.method := WebHTTP.BaselineControlM;
  855. (* TODO: Check whether baseline should have a different format. *)
  856. NEW(reqBody, host, baseline); (* Assume repository is on the same host. *)
  857. Net(url, reqHeader, resHeader, reqBody, out, res);
  858. END;
  859. END BaselineControlSelect;
  860. PROCEDURE Head*(CONST url : ARRAY OF CHAR; VAR resHeader: WebHTTP.ResponseHeader; VAR res : WORD);
  861. VAR
  862. host : ARRAY 128 OF CHAR;
  863. path : ARRAY 256 OF CHAR;
  864. port : LONGINT;
  865. w : Streams.Writer;
  866. r : Streams.Reader;
  867. BEGIN
  868. IF OpenConnection ( url, host, path, port, res ) THEN
  869. NEW(w, con.Send, 4096);
  870. NEW(r, con.Receive, 4096);
  871. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.HeadM, path, host);
  872. IF basicAuth # "" THEN
  873. w.String('Authorization: '); w.String(basicAuth); w.Ln;
  874. END;
  875. w.Ln; w.Update;
  876. ParseReply ( r, resHeader, res );
  877. con.Close;
  878. con := NIL;
  879. END;
  880. END Head;
  881. (** The HTTP versions is ignored and set to 1.1; uri and host are ignored and taken from the url parameter.
  882. < GET /work/Test.html HTTP/1.1
  883. ?< Host: ketchup.ethz.ch
  884. ?< Content-Length: 0
  885. ?>HTTP/1.1 200 OK
  886. *)
  887. PROCEDURE Get*(CONST url : ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  888. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  889. VAR
  890. host : ARRAY 128 OF CHAR;
  891. path : ARRAY 256 OF CHAR;
  892. port : LONGINT;
  893. w : Streams.Writer;
  894. x : WebHTTP.AdditionalField;
  895. BEGIN
  896. IF OpenConnection ( url, host, path, port, res ) THEN
  897. IF basicAuth # "" THEN
  898. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Authorization", basicAuth);
  899. END;
  900. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Connection", "Keep-Alive");
  901. NEW(w, con.Send, 4096);
  902. NEW(out, con.Receive, 4096);
  903. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.GetM, path, host);
  904. IF reqHeader.referer # "" THEN w.String("Referer: "); w.String(reqHeader.referer); w.Ln END;
  905. IF reqHeader.useragent # "" THEN w.String("User-Agent: "); w.String(reqHeader.useragent); w.Ln END;
  906. IF reqHeader.accept # "" THEN w.String("Accept: "); w.String(reqHeader.accept); w.Ln END;
  907. x := reqHeader.additionalFields;
  908. WHILE x # NIL DO
  909. w.String(x.key); w.String(": "); w.String(x.value); w.Ln;
  910. x := x.next
  911. END;
  912. w.Ln; w.Update;
  913. ParseReply ( out, resHeader, res );
  914. END
  915. END Get;
  916. (** The HTTP versions is ignored and set to 1.1; uri and host are ignored and taken from the url parameter *)
  917. PROCEDURE Put*(CONST url : ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  918. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; in : Streams.Reader; VAR res : WORD);
  919. VAR
  920. host : ARRAY 128 OF CHAR;
  921. path : ARRAY 256 OF CHAR;
  922. port : LONGINT;
  923. w : Streams.Writer; (* to connection *)
  924. x : WebHTTP.AdditionalField;
  925. BEGIN
  926. IF OpenConnection ( url, host, path, port, res ) THEN
  927. IF basicAuth # "" THEN
  928. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Authorization", basicAuth);
  929. END;
  930. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Connection", "Keep-Alive");
  931. NEW(w, con.Send, 1280);
  932. NEW(out, con.Receive, 1280);
  933. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.PutM, path, host);
  934. IF reqHeader.referer # "" THEN w.String("Referer: "); w.String(reqHeader.referer); w.Ln END;
  935. IF reqHeader.useragent # "" THEN w.String("User-Agent: "); w.String(reqHeader.useragent); w.Ln END;
  936. IF reqHeader.accept # "" THEN w.String("Accept: "); w.String(reqHeader.accept); w.Ln END;
  937. x := reqHeader.additionalFields;
  938. WHILE x # NIL DO
  939. w.String(x.key); w.String(": "); w.String(x.value); w.Ln();
  940. x := x.next
  941. END;
  942. w.Ln;
  943. SendData(in, w); (* Send file data *)
  944. w.Update();
  945. ParseReply ( out, resHeader, res );
  946. END
  947. END Put;
  948. (**
  949. < VERSION-CONTROL /work/Test.html HTTP/1.1
  950. < Host: ketchup.ethz.ch
  951. < Content-Length: 0
  952. >HTTP/1.1 200 OK
  953. *)
  954. PROCEDURE VersionControlFreeze*(CONST url: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  955. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  956. BEGIN
  957. reqHeader.method := WebHTTP.VersionControlM;
  958. Net(url, reqHeader, resHeader, NIL, out, res);
  959. END VersionControlFreeze;
  960. PROCEDURE VersionControlSelect*(CONST url, ver: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  961. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  962. CONST PLog = FALSE;
  963. VAR
  964. host : ARRAY 128 OF CHAR;
  965. path : ARRAY 256 OF CHAR;
  966. port : LONGINT;
  967. w : Streams.Writer;
  968. xmlDoc: XML.Document;
  969. (* For bodytracing. TODO: Update should be converted to Net(). *)
  970. CONST StringWriterSize = 10000;
  971. VAR xmlSize: LONGINT; buf: ARRAY StringWriterSize OF CHAR; stringWriter: Streams.StringWriter;
  972. aosioWriter : Streams.Writer;
  973. BEGIN
  974. xmlSize := 0;
  975. IF OpenConnection ( url, host, path, port, res ) THEN
  976. xmlDoc := xml.SelectReq("version-control", host, ver);
  977. IF PLog THEN OdUtil.Msg3("WebDAVClient.VersionControlSelect", url, ver); END;
  978. NEW(w, con.Send, 4096);
  979. NEW(out, con.Receive, 4096);
  980. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.VersionControlM, path, host);
  981. IF basicAuth # "" THEN
  982. w.String('Authorization: '); w.String(basicAuth); w.Ln;
  983. END;
  984. w.String('Content-Type: text/xml; charset="utf-8"'); w.Ln;
  985. w.String("Content-Length: "); w.Int(xml.XmlSize(xmlDoc), 1); w.Ln;
  986. w.Ln();
  987. xmlDoc.Write(w, NIL, 0); (* Send XML body *)
  988. IF traceLevel >= TlBody THEN
  989. IF xmlSize < StringWriterSize THEN
  990. NEW(stringWriter, StringWriterSize);
  991. aosioWriter := stringWriter; (* Dummy for the compiler. Is compiler correct ? *)
  992. xmlDoc.Write(aosioWriter, NIL, 0);
  993. stringWriter.Get(buf);
  994. log.Enter; log.String(buf); log.Exit;
  995. ELSE
  996. log.Enter; log.String("WebDAVClient:Net StringWriterSize too small. Required:"); log.Int(xmlSize,5); log.Exit;
  997. END;
  998. END;
  999. w.Char(0X); (* Give XML Scanner an EOF *)
  1000. w.Update();
  1001. ParseReply ( out, resHeader, res );
  1002. END
  1003. END VersionControlSelect;
  1004. (**
  1005. < CHECKOUT /work/Test.html HTTP/1.1
  1006. < Host: ketchup.ethz.ch
  1007. < Content-Length: xxx
  1008. <?xml version="1.0" encoding="utf-8" ?>
  1009. <D:checkout xmlns:D="DAV:">
  1010. <D:activity-set>
  1011. <D:href>http://repo.webdav.org/act/fix-bug-23</D:href>
  1012. </D:activity-set>
  1013. </D:checkout>
  1014. >HTTP/1.1 200 OK
  1015. *)
  1016. PROCEDURE Checkout*(CONST url: ARRAY OF CHAR;
  1017. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1018. VAR
  1019. reqHeader : WebHTTP.RequestHeader;
  1020. coReq: OdXml.CheckoutReq;
  1021. host : ARRAY 128 OF CHAR;
  1022. path : ARRAY 256 OF CHAR;
  1023. port : LONGINT;
  1024. BEGIN
  1025. IF WebHTTP.SplitHTTPAdr(url, host, path, port) THEN
  1026. reqHeader.method := WebHTTP.CheckoutM;
  1027. IF server = "svn" THEN
  1028. IF reqLocation # "" THEN
  1029. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Location", reqLocation);
  1030. END;
  1031. NEW(coReq, host, activity);
  1032. ELSE
  1033. coReq := NIL;
  1034. END;
  1035. Net(url, reqHeader, resHeader, coReq, out, res);
  1036. ELSE
  1037. log.Enter; log.String("Checkout host not found : "); log.String(host); log.Exit
  1038. END;
  1039. END Checkout;
  1040. (**
  1041. < MERGE /work/Test.html HTTP/1.1
  1042. < Host: ketchup.ethz.ch
  1043. < Content-Length: xxx
  1044. <?xml version="1.0" encoding="utf-8" ?>
  1045. <D:merge xmlns:D="DAV:">
  1046. <D:source>
  1047. <D:href>http://repo.webdav.org/wrk/svn1</D:href>
  1048. </D:source>
  1049. </D:merge>
  1050. >HTTP/1.1 200 OK
  1051. *)
  1052. PROCEDURE Merge*(CONST url, source: ARRAY OF CHAR;
  1053. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1054. VAR
  1055. reqHeader : WebHTTP.RequestHeader;
  1056. mergeReq: OdXml.MergeSvnReq;
  1057. host : ARRAY 128 OF CHAR;
  1058. path : ARRAY 256 OF CHAR;
  1059. port : LONGINT;
  1060. BEGIN
  1061. IF WebHTTP.SplitHTTPAdr(url, host, path, port) THEN
  1062. reqHeader.method := WebHTTP.MergeM;
  1063. NEW(mergeReq, "D:merge", "D:source", "D:href", source);
  1064. Net(url, reqHeader, resHeader, mergeReq, out, res);
  1065. ELSE
  1066. log.Enter; log.String("Merge host not found : "); log.String(host); log.Exit
  1067. END;
  1068. END Merge;
  1069. (**
  1070. < UNCHECKOUT /work/Test.html HTTP/1.1
  1071. < Host: ketchup.ethz.ch
  1072. < Content-Length: 0
  1073. >HTTP/1.1 200 OK
  1074. *)
  1075. PROCEDURE Uncheckout*(CONST url : ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  1076. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1077. VAR
  1078. host : ARRAY 128 OF CHAR;
  1079. path : ARRAY 256 OF CHAR;
  1080. port : LONGINT;
  1081. w : Streams.Writer;
  1082. BEGIN
  1083. IF OpenConnection ( url, host, path, port, res ) THEN
  1084. NEW(w, con.Send, 512);
  1085. NEW(out, con.Receive, 512);
  1086. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.UncheckoutM, path, host);
  1087. IF basicAuth # "" THEN
  1088. w.String('Authorization: '); w.String(basicAuth); w.Ln;
  1089. END;
  1090. w.Ln();
  1091. w.Char(0X); (* Give XML Scanner an EOF *)
  1092. w.Update();
  1093. ParseReply ( out, resHeader, res );
  1094. END
  1095. END Uncheckout;
  1096. PROCEDURE Report1*(CONST type: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  1097. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1098. VAR
  1099. host : ARRAY 128 OF CHAR;
  1100. path : ARRAY 256 OF CHAR;
  1101. port : LONGINT;
  1102. w : Streams.Writer; (* to connection *)
  1103. xmlDoc: XML.Document;
  1104. s: ARRAY 128 OF CHAR; ok: BOOLEAN;
  1105. BEGIN
  1106. IF type = "version-tree" THEN
  1107. xmlDoc := xml.VersionTreeReq();
  1108. ELSIF type = "compare-baseline" THEN
  1109. ok := WebHTTP.GetAdditionalFieldValue (reqHeader.additionalFields, "compareBaseline", s);
  1110. xmlDoc := xml.Href1Req("compare-baseline", s);
  1111. ELSE
  1112. log.Enter; log.String("Unexpected report type : "); log.String(type); log.Exit;
  1113. RETURN;
  1114. END;
  1115. IF OpenConnection ( reqHeader.uri, host, path, port, res ) THEN
  1116. NEW(w, con.Send, 1280);
  1117. NEW(out, con.Receive, 1280);
  1118. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.ReportM, path, host);
  1119. IF basicAuth # "" THEN
  1120. w.String('Authorization: '); w.String(basicAuth); w.Ln;
  1121. END;
  1122. IF reqHeader.referer # "" THEN w.String("Referer: "); w.String(reqHeader.referer); w.Ln END;
  1123. IF reqHeader.useragent # "" THEN w.String("User-Agent: "); w.String(reqHeader.useragent); w.Ln END;
  1124. w.String('Content-Type: text/xml; charset="utf-8"'); w.Ln;
  1125. w.String("Content-Length: "); w.Int(xml.XmlSize(xmlDoc), 1); w.Ln;
  1126. w.Ln;
  1127. xmlDoc.Write(w, NIL, 0); (* Send XML body *)
  1128. w.Char(0X); (* Give XML Scanner an EOF *)
  1129. w.Update();
  1130. ParseReply ( out, resHeader, res );
  1131. END;
  1132. log.Enter; log.String( "" ); log.Exit;
  1133. END Report1;
  1134. (* Already get the request XML doc as a parameter. *)
  1135. PROCEDURE Report*(CONST url, depth: ARRAY OF CHAR; reqBody: XML.Document;
  1136. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1137. VAR
  1138. reqHeader : WebHTTP.RequestHeader;
  1139. BEGIN
  1140. reqHeader.method := WebHTTP.ReportM;
  1141. IF depth # "" THEN
  1142. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Depth", depth);
  1143. END;
  1144. Net(url, reqHeader, resHeader, reqBody, out, res);
  1145. END Report;
  1146. PROCEDURE Propfind*(CONST url, depth: ARRAY OF CHAR; props: WebHTTP.AdditionalField;
  1147. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1148. VAR
  1149. reqHeader : WebHTTP.RequestHeader; xmlDoc: XML.Document;
  1150. BEGIN
  1151. reqHeader.method := WebHTTP.PropfindM;
  1152. IF depth # "" THEN
  1153. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Depth", depth);
  1154. END;
  1155. IF props # NIL THEN
  1156. xmlDoc := xml.PropfindReq(props);
  1157. ELSE
  1158. xmlDoc := NIL; (* Without body allprop. *)
  1159. END;
  1160. Net(url, reqHeader, resHeader, xmlDoc, out, res);
  1161. END Propfind;
  1162. (* Properties are gives as a list of lines: 1{ name 1{value} } . mode = "set" | "add" *)
  1163. PROCEDURE Proppatch*(CONST url, mode : ARRAY OF CHAR; props: WebHTTP.AdditionalField;
  1164. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1165. VAR
  1166. reqHeader : WebHTTP.RequestHeader; xmlDoc: XML.Document;
  1167. BEGIN
  1168. reqHeader.method := WebHTTP.ProppatchM;
  1169. xmlDoc := xml.ProppatchReq(mode, props);
  1170. Net(url, reqHeader, resHeader, xmlDoc, out, res);
  1171. END Proppatch;
  1172. PROCEDURE Checkin*(CONST url: ARRAY OF CHAR;
  1173. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1174. VAR
  1175. reqHeader : WebHTTP.RequestHeader;
  1176. BEGIN
  1177. reqHeader.method := WebHTTP.CheckinM;
  1178. Net(url, reqHeader, resHeader, NIL, out, res);
  1179. END Checkin;
  1180. (** MOVE RFC2518, 8.9
  1181. >>Request
  1182. MOVE /test/old HTTP/1.1
  1183. Host: webdav.ethz.ch
  1184. Destination: http://webdav.ethz.ch//test/new
  1185. >>Response
  1186. HTTP/1.1 201 Created
  1187. Location: http://webdav.ethz.ch//test/new
  1188. *)
  1189. PROCEDURE Move*(CONST url, destUrl: ARRAY OF CHAR; overwrite: BOOLEAN;
  1190. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1191. VAR
  1192. reqHeader : WebHTTP.RequestHeader; xmlDoc: XML.Document;
  1193. BEGIN
  1194. xmlDoc := NIL;
  1195. reqHeader.method := WebHTTP.MoveM;
  1196. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Destination", destUrl);
  1197. IF ~overwrite THEN (* Default TRUE *)
  1198. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Overwrite", "F");
  1199. END;
  1200. Net(url, reqHeader, resHeader, xmlDoc, out, res);
  1201. END Move;
  1202. PROCEDURE Copy*(CONST url, destUrl : ARRAY OF CHAR; overwrite: BOOLEAN;
  1203. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1204. VAR
  1205. reqHeader : WebHTTP.RequestHeader; xmlDoc: XML.Document;
  1206. BEGIN
  1207. xmlDoc := NIL;
  1208. reqHeader.method := WebHTTP.CopyM;
  1209. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Destination", destUrl);
  1210. IF ~overwrite THEN (* Default TRUE *)
  1211. WebHTTP.SetAdditionalFieldValue(reqHeader.additionalFields, "Overwrite", "F");
  1212. END;
  1213. Net(url, reqHeader, resHeader, xmlDoc, out, res);
  1214. END Copy;
  1215. PROCEDURE Delete*(CONST url: ARRAY OF CHAR;
  1216. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1217. VAR
  1218. reqHeader : WebHTTP.RequestHeader;
  1219. BEGIN
  1220. reqHeader.method := WebHTTP.DeleteM;
  1221. Net(url, reqHeader, resHeader, NIL, out, res);
  1222. END Delete;
  1223. (** Make collection.
  1224. < MKCOL /work/Test.html HTTP/1.1
  1225. < Host: ketchup.ethz.ch
  1226. < Content-Length: 0
  1227. ?>HTTP/1.1 200 OK *)
  1228. PROCEDURE Mkcol*(CONST url: ARRAY OF CHAR;
  1229. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1230. VAR
  1231. reqHeader : WebHTTP.RequestHeader;
  1232. BEGIN
  1233. reqHeader.method := WebHTTP.MkcolM;
  1234. Net(url, reqHeader, resHeader, NIL, out, res);
  1235. END Mkcol;
  1236. (** Make activity. Implemented for subversion. Is just funny URI.
  1237. Remember for later deletion after transaction is finished.
  1238. < MKACTIVITY /repos/!svn/act/1 HTTP/1.1
  1239. < Host: ketchup.ethz.ch
  1240. < Content-Length: 0
  1241. ?>HTTP/1.1 200 OK *)
  1242. PROCEDURE Mkactivity*(CONST url: ARRAY OF CHAR;
  1243. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1244. VAR
  1245. reqHeader : WebHTTP.RequestHeader;
  1246. BEGIN
  1247. COPY(url, activity);
  1248. reqHeader.method := WebHTTP.MkactivityM;
  1249. Net(url, reqHeader, resHeader, NIL, out, res);
  1250. END Mkactivity;
  1251. (** Options request to learn about a new server. Example cadaver: *)
  1252. PROCEDURE Options*(CONST url: ARRAY OF CHAR;
  1253. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1254. VAR
  1255. reqHeader : WebHTTP.RequestHeader;
  1256. BEGIN
  1257. reqHeader.method := WebHTTP.OptionsM;
  1258. Net(url, reqHeader, resHeader, NIL, out, res);
  1259. END Options;
  1260. (* Version can be a number. Then it's just a version number of VCSBase and is sent as <host>/version.<version>.
  1261. Or it's a version url string. For VCSBase it must have the form /hist/<version history>.<version number> *)
  1262. PROCEDURE Update*(CONST url, version: ARRAY OF CHAR; VAR reqHeader : WebHTTP.RequestHeader;
  1263. VAR resHeader: WebHTTP.ResponseHeader; VAR out : Streams.Reader; VAR res : WORD);
  1264. CONST PLog = FALSE;
  1265. VAR
  1266. host : ARRAY 128 OF CHAR;
  1267. path : ARRAY 256 OF CHAR;
  1268. port : LONGINT;
  1269. w : Streams.Writer; (* to connection *)
  1270. xmlDoc: XML.Document;
  1271. (* For bodytracing. TODO: Update should be converted to Net(). *)
  1272. CONST StringWriterSize = 10000;
  1273. VAR xmlSize: LONGINT; buf: ARRAY StringWriterSize OF CHAR; stringWriter: Streams.StringWriter;
  1274. aosioWriter : Streams.Writer;
  1275. BEGIN
  1276. xmlSize := 0;
  1277. IF OpenConnection ( url, host, path, port, res ) THEN
  1278. IF PLog THEN OdUtil.Msg3("WebDAVClient.Update", url, version); END;
  1279. xmlDoc := xml.UpdateReq(host, version);
  1280. NEW(w, con.Send, 1280);
  1281. NEW(out, con.Receive, 1280);
  1282. WebHTTP.WriteRequestLine(w, 1, 1, WebHTTP.UpdateM, path, host);
  1283. IF basicAuth # "" THEN
  1284. w.String('Authorization: '); w.String(basicAuth); w.Ln;
  1285. END;
  1286. IF reqHeader.referer # "" THEN w.String("Referer: "); w.String(reqHeader.referer); w.Ln END;
  1287. IF reqHeader.useragent # "" THEN w.String("User-Agent: "); w.String(reqHeader.useragent); w.Ln END;
  1288. IF xmlDoc # NIL THEN
  1289. w.String('Content-Type: text/xml; charset="utf-8"'); w.Ln;
  1290. w.String("Content-Length: "); w.Int(xml.XmlSize(xmlDoc), 1); w.Ln;
  1291. w.Ln;
  1292. xmlDoc.Write(w, NIL, 0); (* Send XML body *)
  1293. IF traceLevel >= TlBody THEN
  1294. IF xmlSize < StringWriterSize THEN
  1295. NEW(stringWriter, StringWriterSize);
  1296. aosioWriter := stringWriter; (* Dummy for the compiler. Is compiler correct ? *)
  1297. xmlDoc.Write(aosioWriter, NIL, 0);
  1298. stringWriter.Get(buf);
  1299. log.Enter; log.String(buf); log.Exit;
  1300. ELSE
  1301. log.Enter; log.String("WebDAVClient:Net StringWriterSize too small. Required:"); log.Int(xmlSize,5); log.Exit;
  1302. END;
  1303. END;
  1304. END;
  1305. w.Char(0X);
  1306. w.Update(); (* Give XML Scanner an EOF *)
  1307. ParseReply ( out, resHeader, res );
  1308. END
  1309. END Update;
  1310. END OdClient;
  1311. (* (es) Goodie for short log string statements *)
  1312. PROCEDURE ls(CONST prompt, string: ARRAY OF CHAR);
  1313. BEGIN
  1314. log.Enter; log.String(prompt); log.String(string); log.Exit;
  1315. END ls;
  1316. PROCEDURE li(CONST prompt: ARRAY OF CHAR; i: LONGINT);
  1317. BEGIN
  1318. log.Enter; log.String(prompt); log.Int(i,1); log.Exit;
  1319. END li;
  1320. (** Sends all availabe data from src to dst. Goodie copied from WebHTTPServer *)
  1321. PROCEDURE SendData*(src: Streams.Reader; dst: Streams.Writer);
  1322. CONST Log = TRUE;
  1323. BufSize = 512; (* Smaller than PPP Payload. *)
  1324. VAR len: LONGINT; buf: ARRAY BufSize OF CHAR;
  1325. sent: LONGINT; timer: Kernel.Timer;
  1326. BEGIN
  1327. NEW(timer);
  1328. IF Log THEN log.Enter; log.String("SendData "); log.TimeStamp(); log.Exit; END;
  1329. sent := 0;
  1330. WHILE (src.res = Streams.Ok) DO
  1331. src.Bytes(buf, 0, BufSize, len);
  1332. dst.Bytes(buf, 0, len); dst.Update;
  1333. sent := sent + len;
  1334. (*timer.Sleep(300);*) (* wtf *)
  1335. END;
  1336. IF Log THEN li("SendData ", sent); END;
  1337. END SendData;
  1338. PROCEDURE Terminate;
  1339. BEGIN
  1340. log.Close;
  1341. (*lw.Close;*)
  1342. END Terminate;
  1343. (*** Some utility functions for connecting used in Vcc ***)
  1344. PROCEDURE ShowMethodUrl * (method: LONGINT; CONST url: ARRAY OF CHAR);
  1345. VAR line: ARRAY 256 OF CHAR;
  1346. BEGIN
  1347. WebHTTP.GetMethodName(method, line); Strings.Append(line, " "); Strings.Append(line, url);
  1348. log.Enter; log.String(line); log.Exit;
  1349. END ShowMethodUrl;
  1350. PROCEDURE ShowStatus * (VAR res: WebHTTP.ResponseHeader);
  1351. VAR
  1352. realm: ARRAY 64 OF CHAR;
  1353. BEGIN
  1354. log.Enter; log.String("HTTP/1.1 "); log.Int(res.statuscode, 4); log.Exit;
  1355. IF res.statuscode = WebHTTP.Unauthorized THEN
  1356. IF WebHTTP.GetAdditionalFieldValue (res.additionalFields, "WWW-Authenticate", realm) THEN
  1357. log.Enter; log.String("Authorization required: "); log.String(realm); log.Exit;
  1358. END;
  1359. END;
  1360. END ShowStatus;
  1361. PROCEDURE StoreResult2File * (VAR resHeader: WebHTTP.ResponseHeader; res: WORD;
  1362. out : Streams.Reader; CONST target: ARRAY OF CHAR; VAR f: Files.File);
  1363. CONST
  1364. BufSize = 512;
  1365. VAR read : LONGINT;
  1366. timer: Kernel.Timer; slept: LONGINT;
  1367. r: Files.Rider;
  1368. buf : ARRAY BufSize OF CHAR;
  1369. dechunk: WebHTTP.ChunkedInStream; sequential: Streams.Reader;
  1370. chunkSize, remain: LONGINT; token: ARRAY 16 OF CHAR;
  1371. BEGIN
  1372. f := NIL;
  1373. IF res = Ok THEN
  1374. ShowStatus(resHeader);
  1375. NEW(timer); slept := 0; read := 0;
  1376. log.Enter; log.String( resHeader.transferencoding ); log.Ln; log.Exit;
  1377. IF (Strings.Pos("hunked", resHeader.transferencoding) > 0) THEN
  1378. (** ) log.Enter; log.String("Chunking"); log.Exit; ( **)
  1379. NEW(dechunk, out, sequential);
  1380. f := Files.New(target);
  1381. f.Set(r, 0);
  1382. remain := 0;
  1383. LOOP
  1384. IF remain = 0 THEN (* Read the chunk size *)
  1385. out.SkipWhitespace(); out.Token(token); out.SkipLn();
  1386. (* log.Enter; AosOut.Memory(ADDRESSOF(token), 16); log.Exit; *)
  1387. Strings.HexStrToInt(token, chunkSize, res);
  1388. (*log.Enter; log.String(token); log.String(":token,size:"); AosOut.Int(chunkSize, 5); log.Exit;*)
  1389. IF chunkSize = 0 THEN
  1390. (* log.Enter; log.String("EXIT chunkSize = 0"); log.Exit; *)
  1391. EXIT;
  1392. END;
  1393. remain := chunkSize;
  1394. END;
  1395. IF remain > BufSize THEN read := BufSize; ELSE read := remain; END;
  1396. out.Bytes (buf, 0, read, read);
  1397. IF out.res # Streams.Ok THEN
  1398. log.Enter; log.String("EXIT out.res"); log.Exit;
  1399. EXIT;
  1400. END;
  1401. DEC(remain, read);
  1402. (* log.Enter; AosOut.Int(read, 5); log.Exit; *)
  1403. f.WriteBytes(r, buf, 0, read);
  1404. END;
  1405. IF target # "" THEN Files.Register(f); END;
  1406. ELSIF resHeader.contentlength >= 0 THEN
  1407. log.Enter; log.String("resHJeader.contentlength = ");log.Int(resHeader.contentlength,1); log.Exit;
  1408. f := Files.New(target);
  1409. f.Set(r, 0);
  1410. remain := resHeader.contentlength;
  1411. WHILE remain > 0 DO
  1412. IF remain > BufSize THEN read := BufSize; ELSE read := remain; END;
  1413. out.Bytes ( buf, 0, read, read );
  1414. IF out.res # Streams.Ok THEN
  1415. remain := 0;
  1416. log.Enter; log.String("EXIT out.res"); log.Exit;
  1417. ELSE
  1418. DEC ( remain, read );
  1419. f.WriteBytes(r, buf, 0, read);
  1420. END;
  1421. END;
  1422. IF target # "" THEN Files.Register(f); END;
  1423. ELSE
  1424. (* try to read something; due to some bug or missing content-length *)
  1425. f := Files.New(target);
  1426. f.Set(r, 0);
  1427. LOOP
  1428. out.Bytes ( buf, 0, BufSize, read );
  1429. IF out.res # Streams.Ok THEN
  1430. log.Enter; log.String("EXIT out.res"); log.Exit;
  1431. EXIT;
  1432. END;
  1433. f.WriteBytes(r, buf, 0, read);
  1434. END;
  1435. IF target # "" THEN Files.Register(f); END;
  1436. log.Enter; log.String( "resHeader.contentlength < 0" ); log.Ln; log.Exit;
  1437. END;
  1438. ELSE
  1439. log.Enter; log.String( "StoreResult2File: res not ok." ); log.Ln; log.Exit;
  1440. END;
  1441. END StoreResult2File;
  1442. BEGIN
  1443. traceLevel := TlBody;
  1444. NEW(log, "HTTP Client");
  1445. OdUtil.MsgLog := log;
  1446. Modules.InstallTermHandler(Terminate)
  1447. END OdClient.