UpMgr work + Tests and temp store.
[brdnet.git] / BootWeb.pas
blobed2335fdb8b51906667d27682bc865be746de827
1 UNIT BootWeb2;
2 INTERFACE
4 procedure BootWeb(url:AnsiString);
6 IMPLEMENTATION
7 USES ServerLoop,AsyncProcess,MemStream,sysutils;
9 type
10 tWBS=object
11 async:tAPX;
12 procedure EventAsync;
13 procedure EventTimeout;
14 procedure Init(url:ansistring);
15 procedure DoneFreeSelf;
16 end;
18 procedure tWBS.Init(url:ansistring);
19 var args:array [0..2] of pchar;
20 var buffer:pointer;
21 var stream:^tMemoryStream;
22 begin
23 {todo: create buffer and stream, create arg list, set callback, run}
24 args[0]:='httpfetch';
25 args[1]:=pchar(url);
26 args[2]:=nil;
27 GetMem(buffer,1024);
28 new(stream);
29 stream^.Init(buffer,0,1024);
30 async.Init(@args,stream^);
31 async.event:=@EventAsync;
32 Shedule(10000,@EventTimeout); {10s timeout}
33 end;
35 procedure tWBS.EventAsync;
36 begin
37 UnShedule(@EventTimeout);
38 try
39 if (async.exitsignal=0)and(async.exitcode=0) then begin
40 writeln('async success');
41 {parse output}
42 end else raise eXception.createfmt('async failed, signal=%U code=%U',[async.exitsignal,async.exitcode]);
43 finally
44 DoneFreeSelf;
45 end;
46 end;
48 procedure tWBS.EventTimeout;
49 begin
50 {timeout is automatically unsheduled}
51 async.Kill;
52 DoneFreeSelf;
53 raise eXception.create('async timeout');
54 end;
56 procedure tWBS.DoneFreeSelf;
57 begin
58 FreeMem(async.output^.base,async.output^.size);
59 Dispose(async.output);
60 FreeMem(@self,sizeof(self));
61 end;
63 procedure BootWeb(url:AnsiString);
64 var o:^tWBS;
65 begin
66 New(O);
67 o^.Init(url);
68 end;
70 BEGIN
71 BootWeb('http://localhost/');
72 END.