rm some cruft that got imported accidently

git-svn-id: file:///svnroot/lcore/trunk@3 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/httpserver_20080306/bfifo.pas b/httpserver_20080306/bfifo.pas
deleted file mode 100755 (executable)
index 55cc24a..0000000
--- a/httpserver_20080306/bfifo.pas
+++ /dev/null
@@ -1,148 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-unit bfifo;\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-\r
-interface\r
-\r
-uses blinklist,pgtypes;\r
-\r
-const\r
-  pagesize=1420;\r
-\r
-type\r
-  tfifo=class(tobject)\r
-  private\r
-    l:tlinklist;     {add to}\r
-    getl:tlinklist; {remove from}\r
-    ofs:integer;\r
-    getofs:integer;\r
-  public\r
-    size:integer;\r
-    procedure add(data:pointer;len:integer);\r
-    function get(var resultptr:pointer;len:integer):integer;\r
-    procedure del(len:integer);\r
-    constructor create;\r
-    destructor destroy; override;\r
-  end;\r
-\r
-\r
-implementation\r
-\r
-var\r
-  testcount:integer;\r
-\r
-{\r
-\r
-xx1..... add\r
-xxxxxxxx\r
-....2xxx delete\r
-\r
-1 ofs\r
-2 getofs\r
-\r
-}\r
-\r
-procedure tfifo.add;\r
-var\r
-  a:integer;\r
-  p:tlinklist;\r
-begin\r
-  if len <= 0 then exit;\r
-  inc(size,len);\r
-  while len > 0 do begin\r
-    p := l;\r
-    if ofs = pagesize then begin\r
-      p := tplinklist.create;\r
-      if getl = nil then getl := p;\r
-      getmem(tplinklist(p).p,pagesize);\r
-      inc(testcount);\r
-      linklistadd(l,p);\r
-      ofs := 0;\r
-    end;\r
-    a := pagesize - ofs;\r
-    if len < a then a := len;\r
-    move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);\r
-    inc(taddrint(data),a);\r
-    dec(len,a);\r
-    inc(ofs,a);\r
-  end;\r
-end;\r
-\r
-function tfifo.get;\r
-var\r
-  p:tlinklist;\r
-  a:integer;\r
-begin\r
-  if len > size then len := size;\r
-  if len <= 0 then begin\r
-    result := 0;\r
-    resultptr := nil;\r
-    exit;\r
-  end;\r
-  p := getl;\r
-  resultptr := pointer(taddrint(tplinklist(p).p)+getofs);\r
-  result := pagesize-getofs;\r
-  if result > len then result := len;\r
-end;\r
-\r
-procedure tfifo.del;\r
-var\r
-  a:integer;\r
-  p,p2:tlinklist;\r
-begin\r
-  if len <= 0 then exit;\r
-  p := getl;\r
-  if len > size then len := size;\r
-  dec(size,len);\r
-\r
-  if len = 0 then exit;\r
-\r
-  while len > 0 do begin\r
-    a := pagesize-getofs;\r
-    if a > len then a := len;\r
-    inc(getofs,a);\r
-    dec(len,a);\r
-    if getofs = pagesize then begin\r
-      p2 := p.prev;\r
-      freemem(tplinklist(p).p);\r
-      dec(testcount);\r
-      linklistdel(l,p);\r
-      p.destroy;\r
-      p := p2;\r
-      getl := p;\r
-      getofs := 0;\r
-    end;\r
-  end;\r
-\r
-  if size = 0 then begin\r
-    if assigned(l) then begin\r
-      p := l;\r
-      freemem(tplinklist(p).p);\r
-      dec(testcount);\r
-      linklistdel(l,p);\r
-      p.destroy;\r
-      getl := nil;\r
-    end;\r
-    ofs := pagesize;\r
-    getofs := 0;\r
-  end;\r
-end;\r
-\r
-constructor tfifo.create;\r
-begin\r
-  ofs := pagesize;\r
-  inherited create;\r
-end;\r
-\r
-destructor tfifo.destroy;\r
-begin\r
-  del(size);\r
-  inherited destroy;\r
-end;\r
-\r
-end.\r

diff --git a/httpserver_20080306/binipstuff.pas b/httpserver_20080306/binipstuff.pas
deleted file mode 100755 (executable)
index ebb9f9c..0000000
--- a/httpserver_20080306/binipstuff.pas
+++ /dev/null
@@ -1,395 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-unit binipstuff;\r
-\r
-interface\r
-\r
-{$ifndef win32}\r
-{$ifdef ipv6}\r
-uses sockets;\r
-{$endif}\r
-{$endif}\r
-\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-{$ifdef cpu386}{$define i386}{$endif}\r
-{$ifdef i386}{$define ENDIAN_LITTLE}{$endif}\r
-\r
-{$include uint32.inc}\r
-\r
-const\r
-  hexchars:array[0..15] of char='0123456789abcdef';\r
-  AF_INET=2;\r
-  {$ifdef win32}\r
-    AF_INET6=23;\r
-  {$else}\r
-    AF_INET6=10;\r
-  {$endif}\r
-\r
-type\r
-  {$ifdef ipv6}\r
-    \r
-    {$ifdef win32}\r
-      {$define want_Tin6_addr}\r
-    {$endif}\r
-    {$ifdef ver1_0}\r
-      {$define want_Tin6_addr}\r
-    {$endif}\r
-    {$ifdef want_Tin6_addr}\r
-      Tin6_addr = packed record\r
-        case byte of\r
-          0: (u6_addr8  : array[0..15] of byte);\r
-          1: (u6_addr16 : array[0..7] of Word);\r
-          2: (u6_addr32 : array[0..3] of uint32);\r
-          3: (s6_addr8  : array[0..15] of shortint);\r
-          4: (s6_addr   : array[0..15] of shortint);\r
-          5: (s6_addr16 : array[0..7] of smallint);\r
-          6: (s6_addr32 : array[0..3] of LongInt);\r
-      end;\r
-    {$endif}\r
-  {$endif}\r
-\r
-  tbinip=record\r
-    family:integer;\r
-    {$ifdef ipv6}\r
-      case integer of\r
-        0: (ip:longint);\r
-        1: (ip6:tin6_addr);\r
-    {$else}\r
-      ip:longint;\r
-    {$endif}\r
-  end;\r
-\r
-  {$ifdef win32}\r
-    TInetSockAddr = packed Record\r
-      family:Word;\r
-      port  :Word;\r
-      addr  :uint32;\r
-      pad   :array [1..8] of byte;\r
-    end;\r
-    {$ifdef ipv6}\r
-\r
-      TInetSockAddr6 = packed record\r
-        sin6_family: word;\r
-        sin6_port: word;\r
-        sin6_flowinfo: uint32;\r
-        sin6_addr: tin6_addr;\r
-        sin6_scope_id: uint32;\r
-      end;\r
-    {$endif}\r
-  {$endif}\r
-\r
-function htons(w:word):word;\r
-function htonl(i:uint32):uint32;\r
-\r
-function ipstrtobin(const s:string;var binip:tbinip):boolean;\r
-function ipbintostr(const binip:tbinip):string;\r
-{$ifdef ipv6}\r
-function ip6bintostr(const bin:tin6_addr):string;\r
-function ip6strtobin(const s:string;var bin:tin6_addr):boolean;\r
-{$endif}\r
-\r
-function comparebinip(const ip1,ip2:tbinip):boolean;\r
-\r
-{deprecated}\r
-function longip(s:string):longint;\r
-\r
-procedure converttov4(var ip:tbinip);\r
-\r
-implementation\r
-\r
-uses sysutils;\r
-\r
-function htons(w:word):word;\r
-begin\r
-  {$ifdef ENDIAN_LITTLE}\r
-  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);\r
-  {$else}\r
-  result := w;\r
-  {$endif}\r
-end;\r
-\r
-function htonl(i:uint32):uint32;\r
-begin\r
-  {$ifdef ENDIAN_LITTLE}\r
-  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);\r
-  {$else}\r
-  result := i;\r
-  {$endif}\r
-end;\r
-\r
-{internal}\r
-{converts dotted v4 IP to longint. returns host endian order}\r
-function longip(s:string):longint;\r
-var\r
-  l:longint;\r
-  a,b:integer;\r
-function convertbyte(const s:string):integer;\r
-begin\r
-  result := strtointdef(s,-1);\r
-  if result < 0 then begin\r
-    result := -1;\r
-    exit;\r
-  end;\r
-  if result > 255 then begin\r
-    result := -1;\r
-    exit;\r
-  end;\r
-  {01 exception}\r
-  if (result <> 0) and (s[1] = '0') then begin\r
-    result := -1;\r
-    exit;\r
-  end;\r
-  {+1 exception}\r
-  if not (s[1] in ['0'..'9']) then begin\r
-    result := -1;\r
-    exit\r
-  end;\r
-end;\r
-\r
-begin\r
-  result := 0;\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := b shl 24;\r
-  s := copy(s,a+1,256);\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := l or b shl 16;\r
-  s := copy(s,a+1,256);\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := l or b shl 8;\r
-  s := copy(s,a+1,256);\r
-  b := convertbyte(copy(s,1,256));if (b < 0) then exit;\r
-  l := l or b;\r
-  result := l;\r
-end;\r
-\r
-\r
-function ipstrtobin(const s:string;var binip:tbinip):boolean;\r
-begin\r
-  binip.family := 0;\r
-  result := false;\r
-  {$ifdef ipv6}\r
-  if pos(':',s) <> 0 then begin\r
-    {try ipv6. use builtin routine}\r
-    result := ip6strtobin(s,binip.ip6);\r
-    if result then binip.family := AF_INET6;\r
-    exit;\r
-  end;\r
-  {$endif}\r
-\r
-  {try v4}\r
-  binip.ip := htonl(longip(s));\r
-  if (binip.ip <> 0) or (s = '0.0.0.0') then begin\r
-    result := true;\r
-    binip.family := AF_INET;\r
-    exit;\r
-  end;\r
-end;\r
-\r
-function ipbintostr(const binip:tbinip):string;\r
-var\r
-  a:integer;\r
-begin\r
-  result := '';\r
-  {$ifdef ipv6}\r
-  if binip.family = AF_INET6 then begin\r
-    result := ip6bintostr(binip.ip6);\r
-  end else\r
-  {$endif}\r
-  if binip.family = AF_INET then begin\r
-    a := htonl(binip.ip);\r
-    result := inttostr(a shr 24)+'.'+inttostr((a shr 16) and $ff)+'.'+inttostr((a shr 8) and $ff)+'.'+inttostr(a and $ff);\r
-  end;\r
-end;\r
-\r
-\r
-{------------------------------------------------------------------------------}\r
-\r
-{$ifdef ipv6}\r
-\r
-{\r
-IPv6 address binary to/from string conversion routines\r
-written by beware (steendijk at xs4all dot nl)\r
-\r
-- implementation does not depend on other ipv6 code such as the tin6_addr type,\r
-  the parameter can also be untyped.\r
-- it is host endian neutral - binary format is aways network order\r
-- it supports compression of zeroes\r
-- it supports ::ffff:192.168.12.34 style addresses\r
-- they are made to do the Right Thing, more efficient implementations are possible\r
-}\r
-\r
-{fpc has hostaddrtostr6 and strtohostaddr6 but the later isnt implemented yet}\r
-\r
-\r
-function ip6bintostr(const bin:tin6_addr):string;\r
-{base16 with lowercase output}\r
-function makehex(w:word):string;\r
-begin\r
-  result := '';\r
-  if w >= 4096 then result := result + hexchars[w shr 12];\r
-  if w >= 256 then result := result + hexchars[w shr 8 and $f];\r
-  if w >= 16 then result := result + hexchars[w shr 4 and $f];\r
-  result := result + hexchars[w and $f];\r
-end;\r
-\r
-var\r
-  a,b,c,addrlen:integer;\r
-  runbegin,runlength:integer;\r
-  bytes:array[0..15] of byte absolute bin;\r
-  words:array[0..7] of word;\r
-  dwords:array[0..3] of integer absolute words;\r
-begin\r
-  for a := 0 to 7 do begin\r
-    words[a] := bytes[a shl 1] shl 8 or bytes[a shl 1 or 1];\r
-  end;\r
-  if (dwords[0] = 0) and (dwords[1] = 0) and (words[4] = 0) and (words[5] = $ffff) then begin\r
-    {::ffff:/96 exception: v4 IP}\r
-    addrlen := 6;\r
-  end else begin\r
-    addrlen := 8;\r
-  end;\r
-  {find longest run of zeroes}\r
-  runbegin := 0;\r
-  runlength := 0;\r
-  for a := 0 to addrlen-1 do begin\r
-    if words[a] = 0 then begin\r
-      c := 0;\r
-      for b := a to addrlen-1 do if words[b] = 0 then begin\r
-        inc(c);\r
-      end else break;\r
-      if (c > runlength) then begin\r
-        runlength := c;\r
-        runbegin := a;\r
-      end;\r
-    end;\r
-  end;\r
-  result := '';\r
-  for a := 0 to runbegin-1 do begin\r
-    if (a <> 0) then result := result + ':';\r
-    result := result + makehex(words[a]);\r
-  end;\r
-  if runlength > 0 then result := result + '::';\r
-  c := runbegin+runlength;\r
-  for a := c to addrlen-1 do begin\r
-    if (a > c) then result := result + ':';\r
-    result := result + makehex(words[a]);\r
-  end;\r
-  if addrlen = 6 then begin\r
-    result := result + ':'+inttostr(bytes[12])+'.'+inttostr(bytes[13])+'.'+inttostr(bytes[14])+'.'+inttostr(bytes[15]);\r
-  end;\r
-end;\r
-\r
-function ip6strtobin(const s:string;var bin:tin6_addr):boolean;\r
-var\r
-  a,b:integer;\r
-  fields:array[0..7] of string;\r
-  fieldcount:integer;\r
-  emptyfield:integer;\r
-  wordcount:integer;\r
-  words:array[0..7] of word;\r
-  bytes:array[0..15] of byte absolute bin;\r
-begin\r
-  result := false;\r
-  for a := 0 to 7 do fields[a] := '';\r
-  fieldcount := 0;\r
-  for a := 1 to length(s) do begin\r
-    if s[a] = ':' then inc(fieldcount) else fields[fieldcount] := fields[fieldcount] + s[a];\r
-    if fieldcount > 7 then exit;\r
-  end;\r
-  if fieldcount < 2 then exit;\r
-\r
-  {find the empty field (compressed zeroes), not counting the first and last there may be at most 1}\r
-  emptyfield := -1;\r
-  for a := 1 to fieldcount-1 do begin\r
-    if fields[a] = '' then begin\r
-      if emptyfield = -1 then emptyfield := a else exit;\r
-    end;\r
-  end;\r
-\r
-  {check if last field is a valid v4 IP}\r
-  a := longip(fields[fieldcount]);\r
-  if (a <> 0) or (fields[fieldcount] = '0.0.0.0') then wordcount := 6 else wordcount := 8;\r
-  {0:1:2:3:4:5:6.6.6.6\r
-   0:1:2:3:4:5:6:7}\r
-  fillchar(words,sizeof(words),0);\r
-  if wordcount = 6 then begin\r
-    if fieldcount > 6 then exit;\r
-    words[6] := a shr 16;\r
-    words[7] := a and $ffff;\r
-  end;\r
-  if emptyfield = -1 then begin\r
-    {no run length: must be an exact number of fields}\r
-    if wordcount = 6 then begin\r
-      if fieldcount <> 6 then exit;\r
-      emptyfield := 5;\r
-    end else if wordcount = 8 then begin\r
-      if fieldcount <> 7 then exit;\r
-      emptyfield := 7;\r
-    end else exit;\r
-  end;\r
-  for a := 0 to emptyfield do begin\r
-    if fields[a] = '' then b := 0 else b := strtointdef('$'+fields[a],-1);\r
-    if (b < 0) or (b > $ffff) then exit;\r
-    words[a] := b;\r
-  end;\r
-  if wordcount = 6 then dec(fieldcount);\r
-  for a := wordcount-1 downto wordcount-(fieldcount-emptyfield) do begin\r
-    b := a+fieldcount-wordcount+1;\r
-    if fields[b] = '' then b := 0 else b := strtointdef('$'+fields[b],-1);\r
-    if (b < 0) or (b > $ffff) then exit;\r
-    words[a] := b;\r
-  end;\r
-  for a := 0 to 7 do begin\r
-    bytes[a shl 1] := words[a] shr 8;\r
-    bytes[a shl 1 or 1] := words[a] and $ff;\r
-  end;\r
-  result := true;\r
-end;\r
-{$endif}\r
-\r
-function comparebinip(const ip1,ip2:tbinip):boolean;\r
-begin\r
-  if (ip1.ip <> ip2.ip) then begin\r
-    result := false;\r
-    exit;\r
-  end;\r
-\r
-  {$ifdef ipv6}\r
-  if ip1.family = AF_INET6 then begin\r
-    if (ip1.ip6.s6_addr32[1] <> ip2.ip6.s6_addr32[1])\r
-    or (ip1.ip6.s6_addr32[2] <> ip2.ip6.s6_addr32[2])\r
-    or (ip1.ip6.s6_addr32[3] <> ip2.ip6.s6_addr32[3]) then begin\r
-      result := false;\r
-      exit;\r
-    end;\r
-  end;\r
-  {$endif}\r
-\r
-  result := (ip1.family = ip2.family);\r
-end;\r
-\r
-{converts a binary IP to v4 if it is a v6 IP in the v4 range}\r
-procedure converttov4(var ip:tbinip);\r
-begin\r
-  {$ifdef ipv6}\r
-  if ip.family = AF_INET6 then begin\r
-    if (ip.ip6.u6_addr32[0] = 0) and (ip.ip6.u6_addr32[1] = 0) and\r
-    (ip.ip6.u6_addr16[4] = 0) and (ip.ip6.u6_addr16[5] = $ffff) then begin\r
-      ip.family := AF_INET;\r
-      ip.ip := ip.ip6.s6_addr32[3];\r
-    end;\r
-  end;\r
-  {$endif}\r
-end;\r
-\r
-end.\r

diff --git a/httpserver_20080306/blinklist.pas b/httpserver_20080306/blinklist.pas
deleted file mode 100755 (executable)
index 2079b75..0000000
--- a/httpserver_20080306/blinklist.pas
+++ /dev/null
@@ -1,118 +0,0 @@
-(*\r
- *  beware IRC services, blinklist.pas\r
- *  Copyright (C) 2002 Bas Steendijk\r
- *\r
- *  This program is free software; you can redistribute it and/or modify\r
- *  it under the terms of the GNU General Public License as published by\r
- *  the Free Software Foundation; either version 2 of the License, or\r
- *  (at your option) any later version.\r
- *\r
- *  This program is distributed in the hope that it will be useful,\r
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of\r
- *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
- *  GNU General Public License for more details.\r
- *\r
- *  You should have received a copy of the GNU General Public License\r
- *  along with this program; if not, write to the Free Software\r
- *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA\r
- *)\r
-unit blinklist;\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-\r
-\r
-interface\r
-\r
-type\r
-  tlinklist=class(tobject)\r
-    next:tlinklist;\r
-    prev:tlinklist;\r
-    constructor create;\r
-    destructor destroy; override;\r
-  end;\r
-\r
-  {linklist with 2 links}\r
-  tlinklist2=class(tlinklist)\r
-    next2:tlinklist2;\r
-    prev2:tlinklist2;\r
-  end;\r
-\r
-  {linklist with one pointer}\r
-  tplinklist=class(tlinklist)\r
-    p:pointer\r
-  end;\r
-\r
-  tstringlinklist=class(tlinklist)\r
-    s:string;\r
-  end;\r
-\r
-  tthing=class(tlinklist)\r
-    name:string;      {name/nick}\r
-    hashname:integer; {hash of name}\r
-  end;\r
-\r
-{\r
-adding new block to list (baseptr)\r
-}\r
-procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
-procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
-\r
-\r
-procedure linklist2add(var baseptr,newptr:tlinklist2);\r
-procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
-\r
-var\r
-  linklistdebug:integer;\r
-\r
-implementation\r
-\r
-procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
-var\r
-  p:tlinklist;\r
-begin\r
-  p := baseptr;\r
-  baseptr := newptr;\r
-  baseptr.prev := nil;\r
-  baseptr.next := p;\r
-  if p <> nil then p.prev := baseptr;\r
-end;\r
-\r
-procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
-begin\r
-  if item = baseptr then baseptr := item.next;\r
-  if item.prev <> nil then item.prev.next := item.next;\r
-  if item.next <> nil then item.next.prev := item.prev;\r
-end;\r
-\r
-procedure linklist2add(var baseptr,newptr:tlinklist2);\r
-var\r
-  p:tlinklist2;\r
-begin\r
-  p := baseptr;\r
-  baseptr := newptr;\r
-  baseptr.prev2 := nil;\r
-  baseptr.next2 := p;\r
-  if p <> nil then p.prev2 := baseptr;\r
-end;\r
-\r
-procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
-begin\r
-  if item = baseptr then baseptr := item.next2;\r
-  if item.prev2 <> nil then item.prev2.next2 := item.next2;\r
-  if item.next2 <> nil then item.next2.prev2 := item.prev2;\r
-end;\r
-\r
-constructor tlinklist.create;\r
-begin\r
-  inherited create;\r
-  inc(linklistdebug);\r
-end;\r
-\r
-destructor tlinklist.destroy;\r
-begin\r
-  dec(linklistdebug);\r
-  inherited destroy;\r
-end;\r
-\r
-end.\r

diff --git a/httpserver_20080306/bsearchtree.pas b/httpserver_20080306/bsearchtree.pas
deleted file mode 100755 (executable)
index ad61751..0000000
--- a/httpserver_20080306/bsearchtree.pas
+++ /dev/null
@@ -1,101 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-  \r
-{actually a hashtable. it was a tree in earlier versions}\r
-\r
-unit bsearchtree;\r
-\r
-interface\r
-\r
-uses blinklist;\r
-\r
-const\r
-  hashtable_size=$4000;\r
-\r
-type\r
-  thashitem=class(tlinklist)\r
-    hash:integer;\r
-    s:string;\r
-    p:pointer;\r
-  end;\r
-  thashtable=array[0..hashtable_size-1] of thashitem;\r
-  phashtable=^thashtable;\r
-\r
-{adds "item" to the tree for name "s". the name must not exist (no checking done)}\r
-procedure addtree(t:phashtable;s:string;item:pointer);\r
-\r
-{removes name "s" from the tree. the name must exist (no checking done)}\r
-procedure deltree(t:phashtable;s:string);\r
-\r
-{returns the item pointer for s, or nil if not found}\r
-function findtree(t:phashtable;s:string):pointer;\r
-\r
-implementation\r
-\r
-function makehash(s:string):integer;\r
-const\r
-  shifter=6;\r
-var\r
-  a,b:integer;\r
-begin\r
-  result := 0;\r
-  b := length(s);\r
-  for a := 1 to b do begin\r
-    result := (result shl shifter) xor byte(s[a]);\r
-  end;\r
-  result := (result xor result shr 16) and (hashtable_size-1);\r
-end;\r
-\r
-procedure addtree(t:phashtable;s:string;item:pointer);\r
-var\r
-  hash:integer;\r
-  p:thashitem;\r
-begin\r
-  hash := makehash(s);\r
-  p := thashitem.create;\r
-  p.hash := hash;\r
-  p.s := s;\r
-  p.p := item;\r
-  linklistadd(tlinklist(t[hash]),tlinklist(p));\r
-end;\r
-\r
-procedure deltree(t:phashtable;s:string);\r
-var\r
-  p,p2:thashitem;\r
-  hash:integer;\r
-begin\r
-  hash := makehash(s);\r
-  p := t[hash];\r
-  p2 := nil;\r
-  while p <> nil do begin\r
-    if p.s = s then begin\r
-      p2 := p;\r
-      break;\r
-    end;\r
-    p := thashitem(p.next);\r
-  end;\r
-  linklistdel(tlinklist(t[hash]),tlinklist(p2));\r
-  p2.destroy;\r
-end;\r
-\r
-\r
-function findtree(t:phashtable;s:string):pointer;\r
-var\r
-  p:thashitem;\r
-  hash:integer;\r
-begin\r
-  result := nil;\r
-  hash := makehash(s);\r
-  p := t[hash];\r
-  while p <> nil do begin\r
-    if p.s = s then begin\r
-      result := p.p;\r
-      exit;\r
-    end;\r
-    p := thashitem(p.next);\r
-  end;\r
-end;\r
-\r
-end.\r

diff --git a/httpserver_20080306/btime.pas b/httpserver_20080306/btime.pas
deleted file mode 100755 (executable)
index 127839e..0000000
--- a/httpserver_20080306/btime.pas
+++ /dev/null
@@ -1,362 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-{\r
-this unit returns unix timestamp with seconds and microseconds (as float)\r
-works on windows/delphi, and on freepascal on unix.\r
-}\r
-\r
-unit btime;\r
-\r
-interface\r
-\r
-type\r
-  float=extended;\r
-\r
-var\r
-  timezone:integer;\r
-  timezonestr:string;\r
-  irctime,unixtime:integer;\r
-  tickcount:integer;\r
-  settimebias:integer;\r
-  qpcjump:float; {can be read out and reset for debug purpose}\r
-  performancecountfreq:extended;\r
-\r
-function irctimefloat:float;\r
-function irctimeint:integer;\r
-\r
-function unixtimefloat:float;\r
-function unixtimeint:integer;\r
-\r
-function wintimefloat:float;\r
-\r
-procedure settime(newtime:integer);\r
-procedure gettimezone;\r
-procedure timehandler;\r
-procedure init;\r
-\r
-function timestring(i:integer):string;\r
-function timestrshort(i:integer):string;\r
-\r
-function oletounixfloat(t:float):float;\r
-function oletounix(t:tdatetime):integer;\r
-function unixtoole(i:integer):tdatetime;\r
-\r
-var\r
-  timefloatbias:float;\r
-  lastunixtimefloat:float=0;\r
-\r
-implementation\r
-\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-\r
-uses\r
-  {$ifdef UNIX}\r
-    {$ifdef VER1_0}\r
-      linux,\r
-    {$else}\r
-      baseunix,unix,unixutil, {needed for 2.0.2}\r
-    {$endif}\r
-  {$else}\r
-    windows,\r
-  {$endif}\r
-  sysutils;\r
-\r
-  {$include unixstuff.inc}\r
-\r
-\r
-const\r
-  daysdifference=25569;\r
-\r
-function oletounixfloat(t:float):float;\r
-begin\r
-  t := (t - daysdifference) * 86400;\r
-  result := t;\r
-end;\r
-\r
-function oletounix(t:tdatetime):integer;\r
-begin\r
-  result := trunc(oletounixfloat(t));\r
-end;\r
-\r
-function unixtoole(i:integer):tdatetime;\r
-begin\r
-  result := ((i)/86400)+daysdifference;\r
-end;\r
-\r
-{$ifdef unix}\r
-{-----------------------------------------*nix/freepascal code to read time }\r
-\r
-function unixtimefloat:float;\r
-var\r
-  tv:ttimeval;\r
-begin\r
-  gettimeofday(tv);\r
-  result := tv.tv_sec+(tv.tv_usec/1000000);\r
-end;\r
-\r
-function wintimefloat:extended;\r
-begin\r
-  result := unixtimefloat;\r
-end;\r
-\r
-function unixtimeint:integer;\r
-var\r
-  tv:ttimeval;\r
-begin\r
-  gettimeofday(tv);\r
-  result := tv.tv_sec;\r
-end;\r
-\r
-{$else} {delphi 3}\r
-{------------------------------ windows/delphi code to read time}\r
-\r
-{ free pascals tsystemtime is incomaptible with windows api calls\r
- so we declare it ourselves - plugwash\r
-}\r
-{$ifdef fpc}\r
-type\r
-  TSystemTime = record\r
-     wYear: Word;\r
-     wMonth: Word;\r
-     wDayOfWeek: Word;\r
-     wDay: Word;\r
-     wHour: Word;\r
-     wMinute: Word;\r
-     wSecond: Word;\r
-     wMilliseconds: Word;\r
-  end;\r
- {$endif}\r
-function Date_utc: extended;\r
-var\r
-  SystemTime: TSystemTime;\r
-begin\r
-  {$ifdef fpc}\r
-    GetsystemTime(@SystemTime);\r
-  {$else}\r
-    GetsystemTime(SystemTime);\r
-  {$endif}\r
-  with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);\r
-end;\r
-\r
-function Time_utc: extended;\r
-var\r
-  SystemTime: TSystemTime;\r
-begin\r
-  {$ifdef fpc}\r
-    GetsystemTime(@SystemTime);\r
-  {$else}\r
-    GetsystemTime(SystemTime);\r
-  {$endif}\r
-  with SystemTime do\r
-    Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);\r
-end;\r
-\r
-function Now_utc: extended;\r
-begin\r
-  Result := round(Date_utc) + Time_utc;\r
-end;\r
-\r
-const\r
-  highdwordconst=4294967296.0;\r
-\r
-function wintimefloat:extended;\r
-var\r
-  p:packed record\r
-    lowpart:longint;\r
-    highpart:longint\r
-  end;\r
-  p2:tlargeinteger absolute p;\r
-  e:extended;\r
-begin\r
-  if performancecountfreq = 0 then begin\r
-    QueryPerformancefrequency(p2);\r
-    e := p.lowpart;\r
-    if e < 0 then e := e + highdwordconst;\r
-    performancecountfreq := ((p.highpart*highdwordconst)+e);\r
-  end;\r
-  queryperformancecounter(p2);\r
-  e := p.lowpart;\r
-  if e < 0 then e := e + highdwordconst;\r
-  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;\r
-end;\r
-\r
-var\r
-  classpriority,threadpriority:integer;\r
-\r
-procedure settc;\r
-var\r
-  hprocess,hthread:integer;\r
-begin\r
-  hProcess := GetCurrentProcess;\r
-  hThread := GetCurrentThread;\r
-\r
-  ClassPriority := GetPriorityClass(hProcess);\r
-  ThreadPriority := GetThreadPriority(hThread);\r
-\r
-  SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);\r
-  SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);\r
-end;\r
-\r
-procedure unsettc;\r
-var\r
-  hprocess,hthread:integer;\r
-begin\r
-  hProcess := GetCurrentProcess;\r
-  hThread := GetCurrentThread;\r
-\r
-  SetPriorityClass(hProcess, ClassPriority);\r
-  SetThreadPriority(hThread,  ThreadPriority);\r
-end;\r
-\r
-function unixtimefloat:float;\r
-var\r
-  f,g,h:float;\r
-begin\r
-  if timefloatbias = 0 then begin\r
-    settc;\r
-    f := now_utc;\r
-    repeat g := now_utc; h := wintimefloat until g > f;\r
-    timefloatbias := oletounixfloat(g)-h;\r
-    unsettc;\r
-  end;\r
-  result := wintimefloat+timefloatbias;\r
-\r
-  {\r
-  workaround for QPC jumps\r
-  (approach 2: always check "hi res" QPC unixtime against the "guaranteed" systemtime one)\r
-  }\r
-  f := result-(oletounixfloat(now_utc));\r
-  if abs(f) > 0.02 then begin\r
-    f := timefloatbias;\r
-    timefloatbias := 0;\r
-    result := unixtimefloat;\r
-    qpcjump := qpcjump + f - timefloatbias;\r
-  end;\r
-\r
-  if (result <= lastunixtimefloat) then result := lastunixtimefloat + 0.0000001;\r
-  lastunixtimefloat := result;\r
-end;\r
-\r
-function unixtimeint:integer;\r
-begin\r
-  result := trunc(unixtimefloat);\r
-end;\r
-\r
-{$endif}\r
-{-----------------------------------------------end of platform specific}\r
-\r
-function irctimefloat:float;\r
-begin\r
-  result := unixtimefloat+settimebias;\r
-end;\r
-\r
-function irctimeint:integer;\r
-begin\r
-  result := unixtimeint+settimebias;\r
-end;\r
-\r
-\r
-procedure settime(newtime:integer);\r
-var\r
-  a:integer;\r
-begin\r
-  a := irctimeint-settimebias;\r
-  if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r
-\r
-  irctime := irctimeint;\r
-end;\r
-\r
-procedure timehandler;\r
-begin\r
-  if unixtime = 0 then init;\r
-  unixtime := unixtimeint;\r
-  irctime := irctimeint;\r
-  if unixtime and 63 = 0 then begin\r
-    {update everything, apply timezone changes, clock changes, etc}\r
-    gettimezone;\r
-    timefloatbias := 0;\r
-    unixtime := unixtimeint;\r
-    irctime := irctimeint;\r
-  end;\r
-end;\r
-\r
-\r
-procedure gettimezone;\r
-var\r
-  {$ifdef UNIX}\r
-    {$ifndef ver1_9_4}\r
-      {$ifndef ver1_0}\r
-        {$define above194}\r
-      {$endif}\r
-    {$endif}\r
-    {$ifndef above194}\r
-      hh,mm,ss:word;\r
-    {$endif}\r
-  {$endif}\r
-  l:integer;\r
-begin\r
-  {$ifdef UNIX}\r
-    {$ifdef above194}\r
-      timezone := tzseconds;\r
-    {$else}\r
-      gettime(hh,mm,ss);\r
-      timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
-    {$endif}\r
-  {$else}\r
-  timezone := round((now-now_utc)*86400);\r
-  {$endif}\r
-\r
-  while timezone > 43200 do dec(timezone,86400);\r
-  while timezone < -43200 do inc(timezone,86400);\r
-\r
-  if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
-  l := abs(timezone) div 60;\r
-  timezonestr := timezonestr + char(l div 600 mod 10+48)+char(l div 60 mod 10+48)+':'+char(l div 10 mod 6+48)+char(l mod 10+48);\r
-end;\r
-\r
-function timestrshort(i:integer):string;\r
-const\r
-  weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
-  month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r
-var\r
-  y,m,d,h,min,sec,ms:word;\r
-  t:tdatetime;\r
-begin\r
-  t := unixtoole(i+timezone);\r
-  decodedate(t,y,m,d);\r
-  decodetime(t,h,min,sec,ms);\r
-  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+\r
-  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+\r
-  inttostr(y);\r
-end;\r
-\r
-function timestring(i:integer):string;\r
-const\r
-  weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
-  month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r
-var\r
-  y,m,d,h,min,sec,ms:word;\r
-  t:tdatetime;\r
-begin\r
-  t := unixtoole(i+timezone);\r
-  decodedate(t,y,m,d);\r
-  decodetime(t,h,min,sec,ms);\r
-  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+\r
-  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+\r
-  timezonestr;\r
-end;\r
-\r
-procedure init;\r
-begin\r
-  qpcjump := 0;\r
-  settimebias := 0;\r
-  gettimezone;\r
-  unixtime := unixtimeint;\r
-  irctime := irctimeint;\r
-end;\r
-\r
-end.\r

diff --git a/httpserver_20080306/dnsasync.pas b/httpserver_20080306/dnsasync.pas
deleted file mode 100755 (executable)
index 682f95f..0000000
--- a/httpserver_20080306/dnsasync.pas
+++ /dev/null
@@ -1,241 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-//FIXME: this code only ever seems to use one dns server for a request and does\r
-//not seem to have any form of retry code.\r
-\r
-unit dnsasync;\r
-\r
-interface\r
-\r
-uses\r
-  {$ifdef win32}\r
-    dnswin,\r
-  {$endif}\r
-  lsocket,lcore,\r
-  classes,binipstuff,dnscore,btime;\r
-\r
-\r
-type\r
-  //after completion or cancelation a dnswinasync may be reused\r
-  tdnsasync=class(tcomponent)\r
-\r
-  private\r
-    //made a load of stuff private that does not appear to be part of the main\r
-    //public interface. If you make any of it public again please consider the\r
-    //consequences when using windows dns. --plugwash.\r
-    sock:twsocket;\r
-\r
-    sockopen:boolean;\r
-\r
-\r
-    state:tdnsstate;\r
-\r
-    dnsserverid:integer;\r
-    startts:double;\r
-    {$ifdef win32}
-      dwas : tdnswinasync;\r
-    {$endif}
-\r
-\r
-    procedure asyncprocess;\r
-    procedure receivehandler(sender:tobject;error:word);\r
-    function sendquery(const packet:tdnspacket;len:integer):boolean;\r
-    {$ifdef win32}
-      procedure winrequestdone(sender:tobject;error:word);\r
-    {$endif}
-  public\r
-    onrequestdone:tsocketevent;\r
-\r
-    //addr and port allow the application to specify a dns server specifically\r
-    //for this dnsasync object. This is not a reccomended mode of operation\r
-    //because it limits the app to one dns server but is kept for compatibility\r
-    //and special uses.\r
-    addr,port:string;\r
-\r
-    //A family value of AF_INET6 will give only\r
-    //ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
-    //results if ipv4 results are not available;\r
-    forwardfamily:integer;\r
-\r
-    procedure cancel;//cancel an outstanding dns request\r
-    function dnsresult:string; //get result of dnslookup as a string\r
-    procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
-    procedure forwardlookup(const name:string); //start forward lookup,\r
-                                                //preffering ipv4\r
-    procedure reverselookup(const binip:tbinip); //start reverse lookup\r
-\r
-    constructor create(aowner:tcomponent); override;\r
-    destructor destroy; override;\r
-\r
-  end;\r
-\r
-implementation\r
-\r
-uses sysutils;\r
-\r
-constructor tdnsasync.create;\r
-begin\r
-  inherited create(aowner);\r
-  dnsserverid := -1;\r
-  sock := twsocket.create(self);\r
-end;\r
-\r
-destructor tdnsasync.destroy;\r
-begin\r
-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,-1);\r
-    dnsserverid := -1;\r
-  end;\r
-  sock.release;\r
-  setstate_request_init('',state);\r
-  inherited destroy;\r
-end;\r
-\r
-procedure tdnsasync.receivehandler;\r
-begin\r
-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));\r
-    dnsserverid := -1;\r
-  end;\r
-{  writeln('received reply');}\r
-  fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
-  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));\r
-  state.parsepacket := true;\r
-  asyncprocess;\r
-end;\r
-\r
-function tdnsasync.sendquery;\r
-begin\r
-{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
-  result := false;\r
-  if len = 0 then exit; {no packet}\r
-  if not sockopen then begin\r
-    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;\r
-    startts := unixtimefloat;\r
-    if port = '' then port := '53';\r
-    sock.port := port;\r
-    sock.Proto := 'udp';\r
-    sock.ondataavailable := receivehandler;\r
-    try\r
-      sock.connect;\r
-    except\r
-      on e:exception do begin\r
-        //writeln('exception '+e.message);\r
-        exit;\r
-      end;\r
-    end;\r
-    sockopen := true;\r
-  end;\r
-  sock.send(@packet,len);\r
-  result := true;\r
-end;\r
-\r
-procedure tdnsasync.asyncprocess;\r
-begin\r
-  state_process(state);\r
-  case state.resultaction of\r
-    action_ignore: begin {do nothing} end;\r
-    action_done: begin\r
-      onrequestdone(self,0);\r
-    end;\r
-    action_sendquery:begin\r
-      sendquery(state.sendpacket,state.sendpacketlen);\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure tdnsasync.forwardlookup;\r
-begin\r
-  {$ifdef win32}\r
-    if usewindns or (addr = '') then begin\r
-      dwas := tdnswinasync.create;\r
-      dwas.onrequestdone := winrequestdone;\r
-      if forwardfamily = AF_INET6 then begin\r
-        dwas.forwardlookup(name,true);\r
-      end else begin\r
-        dwas.forwardlookup(name,false);\r
-      end;\r
-    end;\r
-  {$endif}\r
-\r
-  ipstrtobin(name,state.resultbin);\r
-  if state.resultbin.family <> 0 then begin\r
-    onrequestdone(self,0);\r
-    exit;\r
-  end;\r
-\r
-\r
-  setstate_forward(name,state,forwardfamily);\r
-  asyncprocess;\r
-\r
-end;\r
-\r
-procedure tdnsasync.reverselookup;\r
-\r
-begin\r
-  {$ifdef win32}\r
-    if usewindns or (addr = '') then begin\r
-      dwas := tdnswinasync.create;\r
-      dwas.onrequestdone := winrequestdone;\r
-      dwas.reverselookup(binip);\r
-    end;\r
-  {$endif}\r
-\r
-  setstate_reverse(binip,state);\r
-  asyncprocess;\r
-end;\r
-\r
-function tdnsasync.dnsresult;\r
-begin\r
-  if state.resultstr <> '' then result := state.resultstr else begin\r
-    result := ipbintostr(state.resultbin);\r
-  end;\r
-end;\r
-\r
-procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
-begin\r
-  move(state.resultbin,binip,sizeof(binip));\r
-end;\r
-\r
-procedure tdnsasync.cancel;\r
-begin\r
-  {$ifdef win32}
-    if assigned(dwas) then begin\r
-      dwas.release;\r
-      dwas := nil;\r
-    end else 
-  {$endif}
-  begin\r
-\r
-    if dnsserverid >= 0 then begin\r
-      reportlag(dnsserverid,-1);\r
-      dnsserverid := -1;\r
-    end;\r
-    if sockopen then begin\r
-      sock.close;\r
-      sockopen := false;\r
-    end;\r
-  end;\r
-  setstate_failure(state);\r
-  onrequestdone(self,0);\r
-end;\r
-\r
-{$ifdef win32}
-  procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r 
-  begin\r
-    if dwas.reverse then begin \r
-      state.resultstr := dwas.name;\r
-    end else begin \r
-      state.resultbin := dwas.ip;\r
-      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin\r
-        fillchar(state.resultbin,sizeof(tbinip),0);\r
-      end;\r
-    end;\r
-    dwas.release;\r
-    onrequestdone(self,error);\r
-  end;\r
-{$endif}
-end.\r

diff --git a/httpserver_20080306/dnscore.pas b/httpserver_20080306/dnscore.pas
deleted file mode 100755 (executable)
index bb4fab4..0000000
--- a/httpserver_20080306/dnscore.pas
+++ /dev/null
@@ -1,728 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-{\r
-\r
-  code wanting to use this dns system should act as follows (note: app\r
-  developers will probablly want to use dnsasync or dnssync or write a similar\r
-  wrapper unit of thier own).\r
-\r
-  for normal lookups call setstate_forward or setstate_reverse to set up the\r
-  state, for more obscure lookups use setstate_request_init and fill in other\r
-  relavent state manually.\r
-\r
-  call state_process which will do processing on the information in the state\r
-  and return an action\r
-  action_ignore means that dnscore wants the code that calls it to go\r
-  back to waiting for packets\r
-  action_sendpacket means that dnscore wants the code that calls it to send\r
-  the packet in sendpacket/sendpacketlen and then start (or go back to) listening\r
-  for\r
-  action_done means the request has completed (either suceeded or failed)\r
-\r
-  callers should resend the last packet they tried to send if they have not\r
-  been asked to send a new packet for more than some timeout value they choose.\r
-\r
-  when a packet is received the application should put the packet in\r
-  recvbuf/recvbuflen , set state.parsepacket and call state_process again\r
-\r
-  once the app gets action_done it can determine sucess or failure in the\r
-  following ways.\r
-\r
-  on failure state.resultstr will be an empty string and state.resultbin will\r
-  be zeroed out (easilly detected by the fact that it will have a family of 0)\r
-\r
-  on success for a A or AAAA lookup state.resultstr will be an empty string\r
-  and state.resultbin will contain the result (note: AAAA lookups require IPV6\r
-  enabled).\r
-\r
-  if an A lookup fails and the code is built with ipv6 enabled then the code\r
-  will return any AAAA records with the same name. The reverse does not apply\r
-  so if an application preffers IPV6 but wants IPV4 results as well it must\r
-  check them seperately.\r
-\r
-  on success for any other type of lookup state.resultstr will be an empty\r
-\r
-  note the state contains ansistrings, setstate_init with a null name parameter\r
-  can be used to clean theese up if required.\r
-\r
-  callers may use setstate_failure to mark the state as failed themseleves\r
-  before passing it on to other code, for example this may be done in the event\r
-  of a timeout.\r
-}\r
-unit dnscore;\r
-\r
-\r
-\r
-{$ifdef fpc}{$mode delphi}{$endif}\r
-\r
-\r
-\r
-\r
-\r
-interface\r
-\r
-uses binipstuff,classes,pgtypes;\r
-\r
-var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};\r
-//hint to users of this unit that they should use windows dns instead.\r
-//May be disabled by applications if desired. (e.g. if setting a custom\r
-//dnsserverlist).\r
-\r
-//note: this unit will not be able to self populate it's dns server list on\r
-//older versions of windows.\r
-\r
-const\r
-  maxnamelength=127;\r
-  maxnamefieldlen=63;\r
-  //note: when using action_ignore the dnscore code *must* preserve the contents of state.sendpacket to allow for retries\r
-  //note: action_ignore must not be used in response to the original request but there is no valid reason for doing this anyway\r
-  action_ignore=0;\r
-  action_done=1;\r
-  action_sendquery=2;\r
-  querytype_a=1;\r
-  querytype_cname=5;\r
-  querytype_aaaa=28;\r
-  querytype_ptr=12;\r
-  querytype_ns=2;\r
-  querytype_soa=6;\r
-  querytype_mx=15;\r
-\r
-  maxrecursion=10;\r
-  maxrrofakind=20;\r
-\r
-  retryafter=300000; //microseconds must be less than one second;\r
-  timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)\r
-type\r
-  dvar=array[0..0] of byte;\r
-  pdvar=^dvar;\r
-  tdnspacket=packed record\r
-    id:word;\r
-    flags:word;\r
-    rrcount:array[0..3] of word;\r
-    payload:array[0..511-12] of byte;\r
-  end;\r
-\r
-\r
-\r
-  tdnsstate=record\r
-    id:word;\r
-    recursioncount:integer;\r
-    queryname:string;\r
-    requesttype:word;\r
-    parsepacket:boolean;\r
-    resultstr:string;\r
-    resultbin:tbinip;\r
-    resultaction:integer;\r
-    numrr1:array[0..3] of integer;\r
-    numrr2:integer;\r
-    rrdata:string;\r
-    sendpacketlen:integer;\r
-    sendpacket:tdnspacket;\r
-    recvpacketlen:integer;\r
-    recvpacket:tdnspacket;\r
-    forwardfamily:integer;\r
-  end;\r
-\r
-  trr=packed record\r
-    requesttypehi:byte;\r
-    requesttype:byte;\r
-    clas:word;\r
-    ttl:integer;\r
-    datalen:word;\r
-    data:array[0..511] of byte;\r
-  end;\r
-\r
-  trrpointer=packed record\r
-    p:pointer;\r
-    ofs:integer;\r
-    len:integer;\r
-    namelen:integer;\r
-  end;\r
-\r
-//commenting out functions from interface that do not have documented semantics\r
-//and probablly should not be called from outside this unit, reenable them\r
-//if you must but please document them at the same time --plugwash\r
-\r
-//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
-//function makereversename(const binip:tbinip):string;\r
-\r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
-\r
-//set up state for a foward lookup. A family value of AF_INET6 will give only\r
-//ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
-//results if ipv4 results are not available;\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
-\r
-procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
-procedure setstate_failure(var state:tdnsstate);\r
-//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
-\r
-\r
-procedure state_process(var state:tdnsstate);\r
-\r
-//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
-\r
-//presumablly this is exported to allow more secure random functions\r
-//to be substituted?\r
-var randomfunction:function:integer;\r
-\r
-\r
-procedure populatednsserverlist;\r
-procedure cleardnsservercache;\r
-\r
-var\r
-  dnsserverlist : tstringlist;\r
-//  currentdnsserverno : integer;\r
-\r
-function getcurrentsystemnameserver(var id:integer) :string;\r
-\r
-//var\r
-//  unixnameservercache:string;\r
-{ $endif}\r
-\r
-\r
-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
-var\r
-  failurereason:string;\r
-\r
-implementation\r
-\r
-uses\r
-  {$ifdef win32}\r
-    windows,\r
-  {$endif}\r
-\r
-  sysutils;\r
-\r
-function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
-var\r
-  a,b:integer;\r
-  s:string;\r
-  arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
-begin\r
- { writeln('buildrequest: name: ',name);}\r
-  result := 0;\r
-  fillchar(packet,sizeof(packet),0);\r
-  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);\r
-  packet.flags := htons($0100);\r
-  packet.rrcount[0] := htons($0001);\r
-\r
-\r
-  s := copy(name,1,maxnamelength);\r
-  if s = '' then exit;\r
-  if s[length(s)] <> '.' then s := s + '.';\r
-  b := 0;\r
-  {encode name}\r
-  if (s = '.') then begin\r
-    packet.payload[0] := 0;\r
-    result := 12+5;\r
-  end else begin\r
-    for a := 1 to length(s) do begin\r
-      if s[a] = '.' then begin\r
-        if b > maxnamefieldlen then exit;\r
-        if (b = 0) then exit;\r
-        packet.payload[a-b-1] := b;\r
-        b := 0;\r
-      end else begin\r
-        packet.payload[a] := byte(s[a]);\r
-        inc(b);\r
-      end;\r
-    end;\r
-    if b > maxnamefieldlen then exit;\r
-    packet.payload[length(s)-b] := b;\r
-    result := length(s) + 12+5;\r
-  end;\r
-\r
-  arr[result-1] := 1;\r
-  arr[result-3] := requesttype and $ff;\r
-  arr[result-4] := requesttype shr 8;\r
-end;\r
-\r
-function makereversename(const binip:tbinip):string;\r
-var\r
-  name:string;\r
-  a,b:integer;\r
-begin\r
-  name := '';\r
-  if binip.family = AF_INET then begin\r
-    b := htonl(binip.ip);\r
-    for a := 0 to 3 do begin\r
-      name := name + inttostr(b shr (a shl 3) and $ff)+'.';\r
-    end;\r
-    name := name + 'in-addr.arpa';\r
-  end else\r
-  {$ifdef ipv6}\r
-  if binip.family = AF_INET6 then begin\r
-    for a := 15 downto 0 do begin\r
-      b := binip.ip6.u6_addr8[a];\r
-      name := name + hexchars[b and $f]+'.'+hexchars[b shr 4]+'.';\r
-    end;\r
-    name := name + 'ip6.arpa';\r
-  end else\r
-  {$endif}\r
-  begin\r
-    {empty name}\r
-  end;\r
-  result := name;\r
-end;\r
-\r
-{\r
-decodes DNS format name to a string. does not includes the root dot.\r
-doesnt read beyond len.\r
-empty result + non null failurereason: failure\r
-empty result + null failurereason: internal use\r
-}\r
-function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
-var\r
-  arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
-  s:string;\r
-  a,b:integer;\r
-begin\r
-  numread := 0;\r
-  repeat\r
-    if (start+numread < 0) or (start+numread >= len) then begin\r
-      result := '';\r
-      failurereason := 'decoding name: got out of range1';\r
-      exit;\r
-    end;\r
-    b := arr[start+numread];\r
-    if b >= $c0 then begin\r
-      {recursive sub call}\r
-      if recursion > 10 then begin\r
-        result := '';\r
-        failurereason := 'decoding name: max recursion';\r
-        exit;\r
-      end;\r
-      if ((start+numread+1) >= len) then begin\r
-        result := '';\r
-        failurereason := 'decoding name: got out of range3';\r
-        exit;\r
-      end;\r
-      a := ((b shl 8) or arr[start+numread+1]) and $3fff;\r
-      s := decodename(packet,len,a,recursion+1,a);\r
-      if (s = '') and (failurereason <> '') then begin\r
-        result := '';\r
-        exit;\r
-      end;\r
-      if result <> '' then result := result + '.';\r
-      result := result + s;\r
-      inc(numread,2);\r
-      exit;\r
-    end else if b < 64 then begin\r
-      if (numread <> 0) and (b <> 0) then result := result + '.';\r
-      for a := start+numread+1 to start+numread+b do begin\r
-        if (a >= len) then begin\r
-          result := '';\r
-          failurereason := 'decoding name: got out of range2';\r
-          exit;\r
-        end;\r
-        result := result + char(arr[a]);\r
-      end;\r
-      inc(numread,b+1);\r
-\r
-      if b = 0 then begin\r
-        if (result = '') and (recursion = 0) then result := '.';\r
-        exit; {reached end of name}\r
-      end;\r
-    end else begin\r
-      failurereason := 'decoding name: read invalid char';\r
-      result := '';\r
-      exit; {invalid}\r
-    end;\r
-  until false;\r
-end;\r
-\r
-{==============================================================================}\r
-\r
-procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
-var\r
-  a:integer;\r
-begin\r
-  state.resultaction := action_done;\r
-  state.resultstr := '';\r
-  case trr(rrp.p^).requesttype of\r
-    querytype_a: begin\r
-      if htons(trr(rrp.p^).datalen) <> 4 then exit;\r
-      move(trr(rrp.p^).data,state.resultbin.ip,4);\r
-      state.resultbin.family :=AF_INET;\r
-    end;\r
-    {$ifdef ipv6}\r
-    querytype_aaaa: begin\r
-      if htons(trr(rrp.p^).datalen) <> 16 then exit;\r
-      state.resultbin.family := AF_INET6;\r
-      move(trr(rrp.p^).data,state.resultbin.ip6,16);\r
-    end;\r
-    {$endif}\r
-  else\r
-    {other reply types (PTR, MX) return a hostname}\r
-    state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);\r
-    fillchar(state.resultbin,sizeof(state.resultbin),0);\r
-  end;\r
-end;\r
-\r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
-begin\r
-  {destroy things properly}\r
-  state.resultstr := '';\r
-  state.queryname := '';\r
-  state.rrdata := '';\r
-  fillchar(state,sizeof(state),0);\r
-  state.queryname := name;\r
-  state.parsepacket := false;\r
-end;\r
-\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
-begin\r
-  setstate_request_init(name,state);\r
-  state.forwardfamily := family;\r
-  {$ifdef ipv6}\r
-  if family = AF_INET6 then state.requesttype := querytype_aaaa else\r
-  {$endif}\r
-  state.requesttype := querytype_a;\r
-end;\r
-\r
-procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
-begin\r
-  setstate_request_init(makereversename(binip),state);\r
-  state.requesttype := querytype_ptr;\r
-end;\r
-\r
-procedure setstate_failure(var state:tdnsstate);\r
-begin\r
-  state.resultstr := '';\r
-  fillchar(state.resultbin,sizeof(state.resultbin),0);\r
-  state.resultaction := action_done;\r
-end;\r
-\r
-procedure state_process(var state:tdnsstate);\r
-label recursed;\r
-label failure;\r
-var\r
-  a,b,ofs:integer;\r
-  rrtemp:^trr;\r
-  rrptemp:^trrpointer;\r
-begin\r
-  if state.parsepacket then begin\r
-    if state.recvpacketlen < 12 then begin\r
-      failurereason := 'Undersized packet';\r
-      state.resultaction := action_ignore;\r
-      exit;\r
-    end;\r
-    if state.id <> state.recvpacket.id then begin\r
-      failurereason := 'ID mismatch';\r
-      state.resultaction := action_ignore;\r
-      exit;\r
-    end;\r
-    state.numrr2 := 0;\r
-    for a := 0 to 3 do begin\r
-      state.numrr1[a] := htons(state.recvpacket.rrcount[a]);\r
-      if state.numrr1[a] > maxrrofakind then goto failure;\r
-      inc(state.numrr2,state.numrr1[a]);\r
-    end;\r
-\r
-    setlength(state.rrdata,state.numrr2*sizeof(trrpointer));\r
-\r
-    {- put all replies into a list}\r
-\r
-    ofs := 12;\r
-    {get all queries}\r
-    for a := 0 to state.numrr1[0]-1 do begin\r
-      if (ofs < 12) or (ofs > state.recvpacketlen-4) then goto failure;\r
-      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-      rrptemp.p := @state.recvpacket.payload[ofs-12];\r
-      rrptemp.ofs := ofs;\r
-      decodename(state.recvpacket,state.recvpacketlen,ofs,0,b);\r
-      rrptemp.len := b + 4;\r
-      inc(ofs,rrptemp.len);\r
-    end;\r
-\r
-    for a := state.numrr1[0] to state.numrr2-1 do begin\r
-      if (ofs < 12) or (ofs > state.recvpacketlen-12) then goto failure;\r
-      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-      if decodename(state.recvpacket,state.recvpacketlen,ofs,0,b) = '' then goto failure;\r
-      rrtemp := @state.recvpacket.payload[ofs-12+b]; {rrtemp points to values and result, after initial name}\r
-      rrptemp.p := rrtemp;\r
-      rrptemp.ofs := ofs; {ofs is start of RR before initial name from start of packet}\r
-      rrptemp.namelen := b;\r
-      b := htons(rrtemp.datalen);\r
-      rrptemp.len := b + 10 + rrptemp.namelen;\r
-      inc(ofs,rrptemp.len);\r
-    end;\r
-    if (ofs <> state.recvpacketlen) then begin\r
-      failurereason := 'ofs <> state.packetlen';\r
-      goto failure;\r
-    end;\r
-\r
-    {- check for items of the requested type in answer section, if so return success first}\r
-    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin\r
-      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-      rrtemp := rrptemp.p;\r
-      b := rrptemp.len;\r
-      if rrtemp.requesttype = state.requesttype then begin\r
-        setstate_return(rrptemp^,b,state);\r
-        exit;\r
-      end;\r
-    end;\r
-\r
-    {if no items of correct type found, follow first cname in answer section}\r
-    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin\r
-      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-      rrtemp := rrptemp.p;\r
-      b := rrptemp.len;\r
-      if rrtemp.requesttype = querytype_cname then begin\r
-        state.queryname := decodename(state.recvpacket,state.recvpacketlen,rrptemp.ofs+12,0,b);\r
-        goto recursed;\r
-      end;\r
-    end;\r
-\r
-    {no cnames found, no items of correct type found}\r
-    if state.forwardfamily <> 0 then goto failure;\r
-{$ifdef ipv6}\r
-    if (state.requesttype = querytype_a) then begin\r
-      {v6 only: in case of forward, look for AAAA in alternative section}\r
-      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin\r
-        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-        rrtemp := rrptemp.p;\r
-        b := rrptemp.len;\r
-        if rrtemp.requesttype = querytype_aaaa then begin\r
-          setstate_return(rrptemp^,b,state);\r
-          exit;\r
-        end;\r
-      end;\r
-      {no AAAA's found in alternative, do a recursive lookup for them}\r
-      state.requesttype := querytype_aaaa;\r
-      goto recursed;\r
-    end;\r
-{$endif}\r
-    goto failure;\r
-recursed:\r
-    {here it needs recursed lookup}\r
-    {if needing to follow a cname, change state to do so}\r
-    inc(state.recursioncount);\r
-    if state.recursioncount > maxrecursion then goto failure;\r
-  end;\r
-\r
-  {here, a name needs to be resolved}\r
-  if state.queryname = '' then begin\r
-    failurereason := 'empty query name';\r
-    goto failure;\r
-  end;\r
-\r
-  {do /ets/hosts lookup here}\r
-  state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);\r
-  if state.sendpacketlen = 0 then begin\r
-    failurereason := 'building request packet failed';\r
-    goto failure;\r
-  end;\r
-  state.id := state.sendpacket.id;\r
-  state.resultaction := action_sendquery;\r
-\r
-  exit;\r
-failure:\r
-  setstate_failure(state);\r
-end;\r
-{$ifdef win32}\r
-  const\r
-    MAX_HOSTNAME_LEN = 132;\r
-    MAX_DOMAIN_NAME_LEN = 132;\r
-    MAX_SCOPE_ID_LEN = 260    ;\r
-    MAX_ADAPTER_NAME_LENGTH = 260;\r
-    MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
-    MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
-    ERROR_BUFFER_OVERFLOW = 111;\r
-    MIB_IF_TYPE_ETHERNET = 6;\r
-    MIB_IF_TYPE_TOKENRING = 9;\r
-    MIB_IF_TYPE_FDDI = 15;\r
-    MIB_IF_TYPE_PPP = 23;\r
-    MIB_IF_TYPE_LOOPBACK = 24;\r
-    MIB_IF_TYPE_SLIP = 28;\r
-\r
-\r
-  type\r
-    tip_addr_string=packed record\r
-      Next :pointer;\r
-      IpAddress : array[0..15] of char;\r
-      ipmask    : array[0..15] of char;\r
-      context   : dword;\r
-    end;\r
-    pip_addr_string=^tip_addr_string;\r
-    tFIXED_INFO=packed record\r
-       HostName         : array[0..MAX_HOSTNAME_LEN-1] of char;\r
-       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of char;\r
-       currentdnsserver : pip_addr_string;\r
-       dnsserverlist    : tip_addr_string;\r
-       nodetype         : longint;\r
-       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of char;\r
-       enablerouting    : longbool;\r
-       enableproxy      : longbool;\r
-       enabledns        : longbool;\r
-    end;\r
-    pFIXED_INFO=^tFIXED_INFO;\r
-\r
-  var\r
-    iphlpapi : thandle;\r
-    getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
-{$endif}\r
-procedure populatednsserverlist;\r
-var\r
-  {$ifdef win32}\r
-    fixed_info : pfixed_info;\r
-    fixed_info_len : longint;\r
-    currentdnsserver : pip_addr_string;\r
-  {$else}\r
-    t:textfile;\r
-    s:string;\r
-    a:integer;\r
-  {$endif}\r
-begin\r
-  //result := '';\r
-  if assigned(dnsserverlist) then begin\r
-    dnsserverlist.clear;\r
-  end else begin\r
-    dnsserverlist := tstringlist.Create;\r
-  end;\r
-  {$ifdef win32}\r
-    if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
-    if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
-    fixed_info_len := 0;\r
-    if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
-    //fixed_info_len :=sizeof(tfixed_info);\r
-    getmem(fixed_info,fixed_info_len);\r
-    if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
-      freemem(fixed_info);\r
-      exit;\r
-    end;\r
-    currentdnsserver := @(fixed_info.dnsserverlist);\r
-    while assigned(currentdnsserver) do begin\r
-      dnsserverlist.Add(currentdnsserver.IpAddress);\r
-      currentdnsserver := currentdnsserver.next;\r
-    end;\r
-    freemem(fixed_info);\r
-  {$else}\r
-    filemode := 0;\r
-    assignfile(t,'/etc/resolv.conf');\r
-    {$i-}reset(t);{$i+}\r
-    if ioresult <> 0 then exit;\r
-\r
-    while not eof(t) do begin\r
-      readln(t,s);\r
-      if not (copy(s,1,10) = 'nameserver') then continue;\r
-      s := copy(s,11,500);\r
-      while s <> '' do begin\r
-        if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
-      end;\r
-      a := pos(' ',s);\r
-      if a <> 0 then s := copy(s,1,a-1);\r
-      a := pos(#9,s);\r
-      if a <> 0 then s := copy(s,1,a-1);\r
-      //result := s;\r
-      //if result <> '' then break;\r
-      dnsserverlist.Add(s);\r
-    end;\r
-    close(t);\r
-  {$endif}\r
-end;\r
-\r
-procedure cleardnsservercache;\r
-begin\r
-  if assigned(dnsserverlist) then begin\r
-    dnsserverlist.destroy;\r
-    dnsserverlist := nil;\r
-  end;\r
-end;\r
-\r
-function getcurrentsystemnameserver(var id:integer):string;\r
-var \r
-  counter : integer;\r
-\r
-begin\r
-  if not assigned(dnsserverlist) then populatednsserverlist;\r
-  if dnsserverlist.count=0 then raise exception.create('no dns servers availible');\r
-  id := 0;\r
-  if dnsserverlist.count >1 then begin\r
-\r
-    for counter := 1 to dnsserverlist.count-1 do begin\r
-      if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;\r
-    end;\r
-  end;\r
-  result := dnsserverlist[id]\r
-end;\r
-\r
-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
-var\r
-  counter : integer;\r
-  temp : integer;\r
-begin\r
-  if (id < 0) or (id >= dnsserverlist.count) then exit;\r
-  if lag = -1 then lag := timeoutlag;\r
-  for counter := 0 to dnsserverlist.count-1 do begin\r
-    temp := taddrint(dnsserverlist.objects[counter]) *15;\r
-    if counter=id then temp := temp + lag;\r
-    dnsserverlist.objects[counter] := tobject(temp div 16);\r
-  end;\r
-\r
-end;\r
-\r
-{  quick and dirty description of dns packet structure to aid writing and\r
-   understanding of parser code, refer to appropriate RFCs for proper specs\r
-- all words are network order\r
-\r
-www.google.com A request:\r
-\r
-0, 2: random transaction ID\r
-2, 2: flags: only the "recursion desired" bit set. (bit 8 of word)\r
-4, 2: questions: 1\r
-6, 2: answer RR's: 0.\r
-8, 2: authority RR's: 0.\r
-10, 2: additional RR's: 0.\r
-12, n: payload:\r
-  query:\r
-    #03 "www" #06 "google" #03 "com" #00\r
-    size-4, 2: type: host address (1)\r
-    size-2, 2: class: inet (1)\r
-\r
-reply:\r
-\r
-0,2: random transaction ID\r
-2,2: flags: set: response (bit 15), recursion desired (8), recursion available (7)\r
-4,4: questions: 1\r
-6,4: answer RR's: 2\r
-8,4: authority RR's: 9\r
-10,4: additional RR's: 9\r
-12: payload:\r
-  query:\r
-    ....\r
-  answer: CNAME\r
-    0,2 "c0 0c" "name: www.google.com"\r
-    2,2 "00 05" "type: cname for an alias"\r
-    4,2 "00 01" "class: inet"\r
-    6,4: TTL\r
-    10,2: data length "00 17" (23)\r
-    12: the cname name (www.google.akadns.net)\r
-  answer: A\r
-    0,2 ..\r
-    2,2 "00 01" host address\r
-    4,2 ...\r
-    6,4 ...\r
-    10,2: data length (4)\r
-    12,4: binary IP\r
-  authority - 9 records\r
-  additional - 9 records\r
-\r
-\r
-  ipv6 AAAA reply:\r
-    0,2: ...\r
-    2,2: type: 001c\r
-    4,2: class: inet (0001)\r
-    6,2: TTL\r
-    10,2: data size (16)\r
-    12,16: binary IP\r
-\r
-  ptr request: query type 000c\r
-\r
-name compression: word "cxxx" in the name, xxx points to offset in the packet}\r
-\r
-end.\r

diff --git a/httpserver_20080306/dnssync.pas b/httpserver_20080306/dnssync.pas
deleted file mode 100755 (executable)
index c64d320..0000000
--- a/httpserver_20080306/dnssync.pas
+++ /dev/null
@@ -1,262 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-unit dnssync;\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-\r
-interface\r
-  uses\r
-    dnscore,\r
-    binipstuff,\r
-    {$ifdef win32}\r
-      winsock,\r
-      windows,\r
-    {$else}\r
-      {$ifdef VER1_0}\r
-        linux,\r
-      {$else}\r
-        baseunix,unix,\r
-      {$endif}\r
-      sockets,\r
-      fd_utils,\r
-    {$endif}\r
-    sysutils;\r
-\r
-//convert a name to an IP\r
-//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support\r
-//compiled in)\r
-//on error the binip will have a family of 0 (other fiels are also currently\r
-//zeroed out but may be used for further error information in future)\r
-//timeout is in seconds, it is ignored when using windows dns\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
-\r
-\r
-//convert an IP to a name, on error a null string will be returned, other \r
-//details as above\r
-function reverselookup(ip:tbinip;timeout:integer):string;\r
-\r
-\r
-var\r
-  dnssyncserver:string;\r
-  id : integer;\r
-  {$ifdef win32}\r
-    sendquerytime : integer;\r
-  {$else}\r
-    sendquerytime : ttimeval;\r
-  {$endif}\r
-implementation\r
-{$ifdef win32}\r
-  uses dnswin;\r
-{$endif}\r
-\r
-{$i unixstuff.inc}\r
-{$i ltimevalstuff.inc}\r
-\r
-var\r
-  fd:integer;\r
-  state:tdnsstate;\r
-{$ifdef win32}\r
-  const\r
-    winsocket = 'wsock32.dll';\r
-  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r
-  function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';\r
-  type\r
-    fdset=tfdset;\r
-{$endif}\r
-\r
-function sendquery(const packet:tdnspacket;len:integer):boolean;\r
-var\r
-  a:integer;\r
-  addr       : string;\r
-  port       : string;\r
-  inaddr     : TInetSockAddr;\r
-\r
-begin\r
-{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
-  result := false;\r
-  if len = 0 then exit; {no packet}\r
-\r
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
-  port := '53';\r
-\r
-  inAddr.family:=AF_INET;\r
-  inAddr.port:=htons(strtointdef(port,0));\r
-  inAddr.addr:=htonl(longip(addr));\r
-\r
-  sendto(fd,packet,len,0,inaddr,sizeof(inaddr));\r
-  {$ifdef win32}\r
-    sendquerytime := GetTickCount and $3fff;\r
-  {$else}\r
-    gettimeofday(sendquerytime);\r
-  {$endif}\r
-  result := true;\r
-end;\r
-\r
-procedure setupsocket;\r
-var\r
-  inAddrtemp : TInetSockAddr;\r
-begin\r
-  if fd > 0 then exit;\r
-\r
-  fd := Socket(AF_INET,SOCK_DGRAM,0);\r
-  inAddrtemp.family:=AF_INET;\r
-  inAddrtemp.port:=0;\r
-  inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}\r
-  If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin\r
-    {$ifdef win32}\r
-      raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
-    {$else}\r
-      raise Exception.create('unable to bind '+inttostr(socketError));\r
-    {$endif}\r
-  end;\r
-end;\r
-\r
-procedure resolveloop(timeout:integer);\r
-var\r
-  selectresult   : integer;\r
-  fds            : fdset;\r
-  {$ifdef win32}\r
-    endtime      : longint;\r
-    starttime    : longint;\r
-    wrapmode     : boolean;\r
-    currenttime  : integer;\r
-  {$else}\r
-    endtime      : ttimeval;\r
-    currenttime    : ttimeval;\r
-\r
-  {$endif}\r
-  lag            : ttimeval;\r
-  currenttimeout : ttimeval;\r
-  selecttimeout         : ttimeval;\r
-\r
-\r
-begin\r
-  {$ifdef win32}\r
-    starttime := GetTickCount and $3fff;\r
-    endtime := starttime +(timeout*1000);\r
-    if (endtime and $4000)=0 then begin\r
-      wrapmode := false;\r
-    end else begin\r
-      wrapmode := true;\r
-    end;\r
-    endtime := endtime and $3fff;\r
-  {$else}\r
-    gettimeofday(endtime);\r
-    endtime.tv_sec := endtime.tv_sec + timeout;\r
-  {$endif}\r
-\r
-  setupsocket;\r
-  repeat\r
-    state_process(state);\r
-    case state.resultaction of\r
-      action_ignore: begin\r
-{        writeln('ignore');}\r
-        {do nothing}\r
-      end;\r
-      action_done: begin\r
-{        writeln('done');}\r
-        exit;\r
-        //onrequestdone(self,0);\r
-      end;\r
-      action_sendquery:begin\r
-{        writeln('send query');}\r
-        sendquery(state.sendpacket,state.sendpacketlen);\r
-      end;\r
-    end;\r
-    {$ifdef win32}\r
-      currenttime := GetTickCount and $3fff;\r
-      msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);\r
-    {$else}\r
-      gettimeofday(currenttime);\r
-      selecttimeout := endtime;\r
-      tv_substract(selecttimeout,currenttime);\r
-    {$endif}\r
-    fd_zero(fds);\r
-    fd_set(fd,fds);\r
-    if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
-      selecttimeout.tv_sec := 0;\r
-      selecttimeout.tv_usec := retryafter;\r
-    end;\r
-    selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);\r
-    if selectresult > 0 then begin\r
-{      writeln('selectresult>0');}\r
-      //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
-      fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
-      {$ifdef win32}\r
-        msectotimeval(lag,(currenttime-sendquerytime)and$3fff);\r
-      {$else}\r
-        lag := currenttime;\r
-        tv_substract(lag,sendquerytime);\r
-\r
-      {$endif}\r
-\r
-      reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
-      state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);\r
-      state.parsepacket := true;\r
-    end;\r
-    if selectresult < 0 then exit;\r
-    if selectresult = 0 then begin\r
-      {$ifdef win32}\r
-        currenttime := GetTickCount;\r
-      {$else}\r
-        gettimeofday(currenttime);\r
-      {$endif}\r
-      reportlag(id,-1);\r
-      if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin\r
-        exit;\r
-      end else begin\r
-        //resend\r
-        sendquery(state.sendpacket,state.sendpacketlen);\r
-      end;\r
-    end;\r
-  until false;\r
-end;\r
-\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
-var\r
-  dummy : integer;\r
-begin\r
-  ipstrtobin(name,result);\r
-  if result.family <> 0 then exit; //it was an IP address, no need for dns\r
-                                   //lookup\r
-  {$ifdef win32}\r
-    if usewindns then begin\r
-      result := winforwardlookup(name,false,dummy);\r
-      exit;\r
-    end;\r
-  {$endif}\r
-  setstate_forward(name,state,0);\r
-  resolveloop(timeout);\r
-  result := state.resultbin;\r
-end;\r
-\r
-function reverselookup(ip:tbinip;timeout:integer):string;\r
-var\r
-  dummy : integer;\r
-begin\r
-  {$ifdef win32}\r
-    if usewindns then begin\r
-      result := winreverselookup(ip,dummy);\r
-      exit;\r
-    end;\r
-  {$endif}\r
-  setstate_reverse(ip,state);\r
-  resolveloop(timeout);\r
-  result := state.resultstr;\r
-end;\r
-\r
-{$ifdef win32}\r
-  var\r
-    wsadata : twsadata;\r
-\r
-  initialization\r
-    WSAStartUp($2,wsadata);\r
-  finalization\r
-    WSACleanUp;\r
-{$endif}\r
-end.\r
-\r
-\r

diff --git a/httpserver_20080306/dnswin.pas b/httpserver_20080306/dnswin.pas
deleted file mode 100755 (executable)
index bae0780..0000000
--- a/httpserver_20080306/dnswin.pas
+++ /dev/null
@@ -1,332 +0,0 @@
-unit dnswin;\r
-\r
-interface\r
-uses binipstuff,classes,lcore;\r
-\r
-//on failure a null string or zeroed out binip will be retuned and error will be\r
-//set to a windows error code (error will be left untouched under non error\r
-//conditions).\r
-function winforwardlookup(name : string;ipv6preffered : boolean;var error:integer) : tbinip;\r
-function winreverselookup(ip:tbinip;var error:integer):string;\r
-\r
-\r
-type\r
-  //do not call destroy on a tdnswinasync instead call release and the\r
-  //dnswinasync will be freed when appropriate. Calling destroy will block\r
-  //the calling thread until the dns lookup completes.\r
-  //release should only be called from the main thread\r
-  tdnswinasync=class(tthread)\r
-  private\r
-    ipv6preffered : boolean;\r
-    freverse : boolean;\r
-    error : integer;\r
-    freewhendone : boolean;\r
-    hadevent : boolean;\r
-  protected\r
-    procedure execute; override;\r
-  public\r
-    onrequestdone:tsocketevent;\r
-    name : string;\r
-    ip : tbinip;\r
-\r
-    procedure forwardlookup(name:string;ipv6preffered:boolean);\r
-    procedure reverselookup(ip:tbinip);\r
-    destructor destroy; override;\r
-    procedure release;\r
-    constructor create;\r
-    property reverse : boolean read freverse;\r
-\r
-  end;\r
-\r
-implementation\r
-uses\r
-  lsocket,pgtypes,sysutils,winsock,windows,messages;\r
-\r
-type\r
-  //taddrinfo = record; //forward declaration\r
-  paddrinfo = ^taddrinfo;\r
-  taddrinfo = packed record\r
-    ai_flags : longint;\r
-    ai_family : longint;\r
-    ai_socktype : longint;\r
-    ai_protocol : longint;\r
-    ai_addrlen : taddrint;\r
-    ai_canonname : pchar;\r
-    ai_addr : pinetsockaddrv;\r
-    ai_next : paddrinfo;\r
-  end;\r
-  ppaddrinfo = ^paddrinfo;\r
-  tgetaddrinfo = function(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r
-  tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;\r
-  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;\r
-var\r
-  getaddrinfo : tgetaddrinfo;\r
-  freeaddrinfo : tfreeaddrinfo;\r
-  getnameinfo : tgetnameinfo;\r
-procedure v4onlyfreeaddrinfo(ai : paddrinfo); stdcall;\r
-begin\r
-  freemem(ai.ai_addr);\r
-  freemem(ai);\r
-end;\r
-\r
-type\r
-  plongint = ^longint;\r
-  pplongint = ^plongint;\r
-\r
-function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;\r
-var\r
-  output : paddrinfo;\r
-  hostent : phostent;\r
-begin\r
-  if hints.ai_family = af_inet then begin\r
-    result := 0;\r
-    getmem(output,sizeof(taddrinfo));\r
-    getmem(output.ai_addr,sizeof(tinetsockaddr));\r
-    output.ai_addr.InAddr.family := af_inet;\r
-    if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0;\r
-    hostent := gethostbyname(nodename);\r
-    if hostent = nil then begin\r
-      result := wsagetlasterror;\r
-      v4onlyfreeaddrinfo(output);\r
-      exit;\r
-    end;\r
-    output.ai_addr.InAddr.addr := pplongint(hostent.h_addr_list)^^;\r
-    output.ai_flags := 0;\r
-    output.ai_family := af_inet;\r
-    output.ai_socktype := 0;\r
-    output.ai_protocol := 0;\r
-    output.ai_addrlen := sizeof(tinetsockaddr);\r
-    output.ai_canonname := nil;\r
-    output.ai_next := nil;\r
-\r
-    res^ := output;\r
-  end else begin\r
-    result := WSANO_RECOVERY;\r
-  end;\r
-end;\r
-\r
-function min(a,b : integer):integer;\r
-begin\r
-  if a<b then result := a else result := b;\r
-end;\r
-\r
-function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;\r
-var\r
-  hostent : phostent;\r
-  bytestocopy : integer;\r
-begin\r
-  if sa.InAddr.family = af_inet then begin\r
-    result := 0;\r
-    hostent := gethostbyaddr(@(sa.inaddr.addr),4,AF_INET);\r
-    if hostent = nil then begin\r
-      result := wsagetlasterror;\r
-      exit;\r
-    end;\r
-    bytestocopy := min(strlen(hostent.h_name)+1,hostlen);\r
-    move((hostent.h_name)^,host^,bytestocopy);\r
-\r
-\r
-  end else begin\r
-    result := WSANO_RECOVERY;\r
-  end;\r
-end;\r
-\r
-\r
-procedure populateprocvars;\r
-var\r
-  libraryhandle : hmodule;\r
-  i : integer;\r
-  dllname : string;\r
-\r
-begin\r
-  if assigned(getaddrinfo) then exit; //procvars already populated\r
-  for i := 0 to 1 do begin\r
-    if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';\r
-    libraryhandle := LoadLibrary(pchar(dllname));\r
-    getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');\r
-    freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');\r
-    getnameinfo := getprocaddress(libraryhandle,'getnameinfo');\r
-    if assigned(getaddrinfo) and assigned(freeaddrinfo) and assigned(getnameinfo) then begin\r
-      //writeln('found getaddrinfo and freeaddrinfo in'+dllname);\r
-      exit; //success\r
-    end;\r
-\r
-  end;\r
-  //writeln('could not find getaddrinfo and freeaddrinfo, falling back to ipv4 only lookup');\r
-  getaddrinfo := v4onlygetaddrinfo;\r
-  freeaddrinfo := v4onlyfreeaddrinfo;\r
-  getnameinfo := v4onlygetnameinfo;\r
-end;\r
-\r
-\r
-function winforwardlookup(name : string;ipv6preffered : boolean;var error : integer) : tbinip;\r
-var\r
-  hints: taddrinfo;\r
-  res : paddrinfo;\r
-  pass : boolean;\r
-  ipv6 : boolean;\r
-  getaddrinforesult : integer;\r
-begin\r
-  populateprocvars;\r
-\r
-  for pass := false to true do begin\r
-    ipv6 := ipv6preffered xor pass;\r
-    hints.ai_flags := 0;\r
-    if ipv6 then begin\r
-      hints.ai_family := AF_INET6;\r
-    end else begin\r
-      hints.ai_family := AF_INET;\r
-    end;\r
-    hints.ai_socktype := 0;\r
-    hints.ai_protocol := 0;\r
-    hints.ai_addrlen := 0;\r
-    hints.ai_canonname := nil;\r
-    hints.ai_addr := nil;\r
-    hints.ai_next := nil;\r
-    getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);\r
-    if getaddrinforesult = 0 then begin\r
-      if res.ai_family = af_inet then begin\r
-        result.family := af_inet;\r
-        result.ip := res.ai_addr.InAddr.addr;\r
-      end else if res.ai_family = af_inet6 then begin\r
-        result.family := af_inet6;\r
-        result.ip6 := res.ai_addr.InAddr6.sin6_addr;\r
-      end;\r
-\r
-      freeaddrinfo(res);\r
-      exit;\r
-    end;\r
-  end;\r
-  if getaddrinforesult <> 0 then begin\r
-    fillchar(result,0,sizeof(result));\r
-    error := getaddrinforesult;\r
-  end;\r
-end;\r
-\r
-function winreverselookup(ip:tbinip;var error : integer):string;\r
-var\r
-  sa : tinetsockaddrv;\r
-  getnameinforesult : integer;\r
-begin\r
-\r
-  if ip.family = AF_INET then begin\r
-    sa.InAddr.family := AF_INET;\r
-    sa.InAddr.port := 1;\r
-    sa.InAddr.addr := ip.ip;\r
-  end else if ip.family = AF_INET6 then begin\r
-    sa.InAddr6.sin6_family  := AF_INET6;\r
-    sa.InAddr6.sin6_port := 1;\r
-    sa.InAddr6.sin6_addr := ip.ip6;\r
-  end else begin\r
-    raise exception.create('unrecognised address family');\r
-  end;\r
-  populateprocvars;\r
-  setlength(result,1025);\r
-  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);\r
-  if getnameinforesult <> 0 then begin\r
-    error := getnameinforesult;\r
-    result := '';\r
-    exit;\r
-  end;\r
-  if pos(#0,result) >= 0 then begin\r
-    setlength(result,pos(#0,result)-1);\r
-  end;\r
-end;\r
-\r
-var\r
-  hwnddnswin : hwnd;\r
-\r
-function MyWindowProc(\r
-    ahWnd   : HWND;\r
-    auMsg   : Integer;\r
-    awParam : WPARAM;\r
-    alParam : LPARAM): Integer; stdcall;\r
-var\r
-  dwas : tdnswinasync;\r
-begin\r
-  if (ahwnd=hwnddnswin) and (aumsg=wm_user) then begin\r
-    Dwas := tdnswinasync(alparam);\r
-    dwas.hadevent := true;\r
-    if assigned (dwas.onrequestdone) then dwas.onrequestdone(dwas,awparam);\r
-    if dwas.freewhendone then dwas.free;\r
-  end else begin\r
-    //not passing unknown messages on to defwindowproc will cause window\r
-    //creation to fail! --plugwash\r
-    Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
-  end;\r
-end;\r
-\r
-procedure tdnswinasync.forwardlookup(name:string;ipv6preffered:boolean);\r
-begin\r
-  self.name := name;\r
-  self.ipv6preffered := ipv6preffered;\r
-  freverse := false;\r
-  resume;\r
-end;\r
-procedure tdnswinasync.reverselookup(ip:tbinip);\r
-begin\r
-  self.ip := ip;\r
-  freverse := true;\r
-  resume;\r
-end;\r
-procedure tdnswinasync.execute;\r
-var\r
-  error : integer;\r
-begin\r
-  error := 0;\r
-  if reverse then begin\r
-    name := winreverselookup(ip,error);\r
-  end else begin\r
-    ip := winforwardlookup(name,ipv6preffered,error);\r
-\r
-  end;\r
-\r
-  postmessage(hwnddnswin,wm_user,error,taddrint(self));\r
-end;\r
-\r
-destructor tdnswinasync.destroy; \r
-begin\r
-  WaitFor;\r
-  inherited destroy;\r
-end;\r
-procedure tdnswinasync.release;\r
-begin\r
-  if hadevent then destroy else begin\r
-    onrequestdone := nil;\r
-    freewhendone := true;\r
-  end;\r
-end;\r
-\r
-constructor tdnswinasync.create;\r
-begin\r
-  inherited create(true);\r
-end;\r
-\r
-var\r
-  MyWindowClass : TWndClass = (style         : 0;\r
-                                 lpfnWndProc   : @MyWindowProc;\r
-                                 cbClsExtra    : 0;\r
-                                 cbWndExtra    : 0;\r
-                                 hInstance     : 0;\r
-                                 hIcon         : 0;\r
-                                 hCursor       : 0;\r
-                                 hbrBackground : 0;\r
-                                 lpszMenuName  : nil;\r
-                                 lpszClassName : 'dnswinClass');\r
-begin\r
-\r
-    if Windows.RegisterClass(MyWindowClass) = 0 then halt;\r
-  //writeln('about to create lcore handle, hinstance=',hinstance);\r
-  hwnddnswin := CreateWindowEx(WS_EX_TOOLWINDOW,\r
-                               MyWindowClass.lpszClassName,\r
-                               '',        { Window name   }\r
-                               WS_POPUP,  { Window Style  }\r
-                               0, 0,      { X, Y          }\r
-                               0, 0,      { Width, Height }\r
-                               0,         { hWndParent    }\r
-                               0,         { hMenu         }\r
-                               HInstance, { hInstance     }\r
-                               nil);      { CreateParam   }\r
-  //writeln('dnswin hwnd is ',hwnddnswin);\r
-  //writeln('last error is ',GetLastError);\r
-end.\r

diff --git a/httpserver_20080306/fd_utils.pas b/httpserver_20080306/fd_utils.pas
deleted file mode 100755 (executable)
index 9ad93dd..0000000
--- a/httpserver_20080306/fd_utils.pas
+++ /dev/null
@@ -1,69 +0,0 @@
-// this file contains code copied from linux.pp in the free pascal rtl\r
-// i had to copy them because i use a different definition of fdset to them\r
-// the copyright block from the file in question is shown below\r
-{\r
-   $Id: fd_utils.pas,v 1.2 2004/08/19 23:12:09 plugwash Exp $\r
-   This file is part of the Free Pascal run time library.\r
-   Copyright (c) 1999-2000 by Michael Van Canneyt,\r
-   BSD parts (c) 2000 by Marco van de Voort\r
-   members of the Free Pascal development team.\r
-\r
-   See the file COPYING.FPC, included in this distribution,\r
-   for details about the copyright.\r
-\r
-   This program is distributed in the hope that it will be useful,\r
-   but WITHOUT ANY WARRANTY;without even the implied warranty of\r
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\r
-\r
-**********************************************************************}\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-  {$inlining on}\r
-{$endif}\r
-unit fd_utils;\r
-interface\r
-\r
-type\r
-    FDSet= Array [0..255] of longint; {31}\r
-    PFDSet= ^FDSet;\r
-const\r
-    absoloutemaxs=(sizeof(fdset)*8)-1;\r
-\r
-Procedure FD_Clr(fd:longint;var fds:fdSet);\r
-Procedure FD_Zero(var fds:fdSet);\r
-Procedure FD_Set(fd:longint;var fds:fdSet);\r
-Function FD_IsSet(fd:longint;var fds:fdSet):boolean;\r
-\r
-\r
-implementation  \r
-uses sysutils;\r
-Procedure FD_Clr(fd:longint;var fds:fdSet);{$ifdef fpc}inline;{$endif}\r
-{ Remove fd from the set of filedescriptors}\r
-begin\r
-  if (fd < 0) then raise exception.create('FD_Clr fd out of range: '+inttostr(fd));\r
-  fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));\r
-end;\r
-\r
-Procedure FD_Zero(var fds:fdSet);\r
-{ Clear the set of filedescriptors }\r
-begin\r
-  FillChar(fds,sizeof(fdSet),0);\r
-end;\r
-\r
-Procedure FD_Set(fd:longint;var fds:fdSet);{$ifdef fpc}inline;{$endif}\r
-{ Add fd to the set of filedescriptors }\r
-begin\r
-  if (fd < 0) then raise exception.create('FD_set fd out of range: '+inttostr(fd));\r
-  fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));\r
-end;\r
-\r
-Function FD_IsSet(fd:longint;var fds:fdSet):boolean;{$ifdef fpc}inline;{$endif}\r
-{ Test if fd is part of the set of filedescriptors }\r
-begin\r
-  if (fd < 0) then begin\r
-    result := false;\r
-    exit;\r
-  end;\r
-  FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);\r
-end;\r
-end.\r

diff --git a/httpserver_20080306/lcore.pas b/httpserver_20080306/lcore.pas
deleted file mode 100755 (executable)
index 51fbf78..0000000
--- a/httpserver_20080306/lcore.pas
+++ /dev/null
@@ -1,889 +0,0 @@
-{lsocket.pas}\r
-\r
-{io and timer code by plugwash}\r
-\r
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-{note: you must use the @ in the last param to tltask.create not doing so will\r
- compile without error but will cause an access violation -pg}\r
-\r
-//note: events after release are normal and are the apps responsibility to deal with safely\r
-\r
-unit lcore;\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-{$ifdef win32}\r
-  {$define nosignal}\r
-{$endif}\r
-interface\r
-  uses\r
-    sysutils,\r
-    {$ifndef win32}\r
-      {$ifdef VER1_0}\r
-        linux,\r
-      {$else}\r
-        baseunix,unix,\r
-      {$endif}\r
-      fd_utils,\r
-    {$endif}\r
-    classes,pgtypes,bfifo;\r
-  procedure processtasks;\r
-\r
-\r
-\r
-\r
-\r
-\r
-\r
-  const\r
-    receivebufsize=1460;\r
-\r
-  type\r
-    {$ifdef ver1_0}\r
-      sigset= array[0..31] of longint;\r
-    {$endif}\r
-\r
-    ESocketException   = class(Exception);\r
-    TBgExceptionEvent  = procedure (Sender : TObject;\r
-                                  E : Exception;\r
-                                  var CanClose : Boolean) of object;\r
-\r
-    // note : tsocketstate is defined in the same way as it is in François PIETTE's twsocket\r
-    // however tlsocket currently only uses wsClosed wsConnecting wsconnected and wsListening\r
-    TSocketState       = (wsInvalidState,\r
-                        wsOpened,     wsBound,\r
-                        wsConnecting, wsConnected,\r
-                        wsAccepting,  wsListening,\r
-                        wsClosed);\r
-\r
-    TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay);\r
-    TWSocketOptions      = set of TWSocketOption;\r
-\r
-    TSocketevent     = procedure(Sender: TObject; Error: word) of object;\r
-    //Tdataavailevent  = procedure(data : string);\r
-    TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;\r
-\r
-    tlcomponent = class(tcomponent)\r
-    public\r
-      released:boolean;\r
-      procedure release; virtual;\r
-      destructor destroy; override;\r
-    end;\r
-\r
-    tlasio = class(tlcomponent)\r
-    public\r
-      state              : tsocketstate      ;\r
-      ComponentOptions   : TWSocketOptions;\r
-      fdhandlein         : Longint           ;  {file discriptor}\r
-      fdhandleout        : Longint           ;  {file discriptor}\r
-\r
-      onsessionclosed    : tsocketevent      ;\r
-      ondataAvailable    : tsocketevent      ;\r
-      onsessionAvailable : tsocketevent      ;\r
-\r
-      onsessionconnected : tsocketevent      ;\r
-      onsenddata         : tsenddata      ;\r
-      ondatasent         : tsocketevent      ;\r
-      //connected          : boolean         ;\r
-      nextasin           : tlasio            ;\r
-      prevasin           : tlasio            ;\r
-\r
-      recvq              : tfifo;\r
-      OnBgException      : TBgExceptionEvent ;\r
-      //connectread        : boolean           ;\r
-      sendq              : tfifo;\r
-      closehandles       : boolean           ;\r
-      writtenthiscycle   : boolean           ;\r
-      onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd\r
-      lasterror:integer;\r
-      destroying:boolean;\r
-      function receivestr:string; virtual;\r
-      procedure close;\r
-      procedure abort;\r
-      procedure internalclose(error:word); virtual;\r
-      constructor Create(AOwner: TComponent); override;\r
-\r
-      destructor destroy; override;\r
-      procedure fdcleanup;\r
-      procedure HandleBackGroundException(E: Exception);\r
-      procedure handlefdtrigger(readtrigger,writetrigger:boolean); virtual;\r
-      procedure dup(invalue:longint);\r
-\r
-      function sendflush : integer;\r
-      procedure sendstr(const str : string);virtual;\r
-      procedure putstringinsendbuffer(const newstring : string);\r
-      function send(data:pointer;len:integer):integer;virtual;\r
-      procedure putdatainsendbuffer(data:pointer;len:integer); virtual;\r
-      procedure deletebuffereddata;\r
-\r
-      //procedure messageloop;\r
-      function Receive(Buf:Pointer;BufSize:integer):integer; virtual;\r
-      procedure flush;virtual;{$ifdef win32} abstract;{$endif}\r
-      procedure dodatasent(wparam,lparam:longint);\r
-      procedure doreceiveloop(wparam,lparam:longint);\r
-      procedure sinkdata(sender:tobject;error:word);\r
-\r
-      procedure release; override; {test -beware}\r
-\r
-      function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd\r
-\r
-      procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif}\r
-      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}\r
-      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}\r
-    protected\r
-      procedure dupnowatch(invalue:longint);\r
-    end;\r
-    ttimerwrapperinterface=class(tlcomponent)\r
-    public\r
-      function createwrappedtimer : tobject;virtual;abstract;\r
-//      procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;\r
-      procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);virtual;abstract;\r
-      procedure setenabled(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;\r
-      procedure setinterval(wrappedtimer : tobject;newvalue : integer);virtual;abstract;\r
-    end;\r
-\r
-  var\r
-    timerwrapperinterface : ttimerwrapperinterface;\r
-  type\r
-    {$ifdef win32}\r
-      ttimeval = record\r
-        tv_sec : longint;\r
-        tv_usec : longint;\r
-      end;\r
-    {$endif}\r
-    tltimer=class(tlcomponent)\r
-    protected\r
-\r
-\r
-      wrappedtimer : tobject;\r
-\r
-\r
-//      finitialevent       : boolean           ;\r
-      fontimer            : tnotifyevent      ;\r
-      fenabled            : boolean           ;\r
-      finterval                  : integer          ; {miliseconds, default 1000}\r
-      {$ifndef win32}\r
-        procedure resettimes;\r
-      {$endif}\r
-//      procedure setinitialevent(newvalue : boolean);\r
-      procedure setontimer(newvalue:tnotifyevent);\r
-      procedure setenabled(newvalue : boolean);\r
-      procedure setinterval(newvalue : integer);\r
-    public\r
-      //making theese public for now, this code should probablly be restructured later though\r
-      prevtimer          : tltimer           ;\r
-      nexttimer          : tltimer           ;\r
-      nextts            : ttimeval          ;\r
-\r
-      constructor create(aowner:tcomponent);override;\r
-      destructor destroy;override;\r
-//      property initialevent : boolean read finitialevent write setinitialevent;\r
-      property ontimer : tnotifyevent read fontimer write setontimer;\r
-      property enabled : boolean read fenabled write setenabled;\r
-      property interval        : integer read finterval write setinterval;\r
-\r
-    end;\r
-\r
-    ttaskevent=procedure(wparam,lparam:longint) of object;\r
-\r
-    tltask=class(tobject)\r
-    public\r
-      handler  : ttaskevent;\r
-      obj      : tobject;\r
-      wparam   : longint;\r
-      lparam   : longint;\r
-      nexttask : tltask;\r
-      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-    end;\r
-\r
-\r
-\r
-    teventcore=class\r
-    public\r
-      procedure processmessages; virtual;abstract;\r
-      procedure messageloop; virtual;abstract;\r
-      procedure exitmessageloop; virtual;abstract;\r
-      procedure setfdreverse(fd : integer;reverseto : tlasio);virtual;abstract;\r
-      procedure rmasterset(fd : integer;islistensocket : boolean);  virtual;abstract;\r
-      procedure rmasterclr(fd: integer);  virtual;abstract;\r
-      procedure wmasterset(fd : integer); virtual;abstract;\r
-      procedure wmasterclr(fd: integer);  virtual;abstract;\r
-    end;\r
-var\r
-    eventcore : teventcore;\r
-\r
-procedure processmessages;\r
-procedure messageloop;\r
-procedure exitmessageloop;\r
-\r
-var\r
-  firstasin                             : tlasio     ;\r
-  firsttimer                            : tltimer    ;\r
-  firsttask  , lasttask   , currenttask : tltask     ;\r
-\r
-  numread                               : integer    ;\r
-  mustrefreshfds                        : boolean    ;\r
-{  lcoretestcount:integer;}\r
-\r
-  asinreleaseflag:boolean;\r
-\r
-\r
-procedure disconnecttasks(aobj:tobject);\r
-procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-type\r
-  tonaddtask = procedure(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-var\r
-  onaddtask : tonaddtask;\r
-\r
-\r
-procedure sleep(i:integer);\r
-{$ifndef nosignal}\r
-  procedure prepsigpipe;inline;\r
-{$endif}\r
-\r
-\r
-implementation\r
-{$ifndef nosignal}\r
-  uses {sockets,}lloopback,lsignal;\r
-{$endif}\r
-{$ifdef win32}\r
-  uses windows;\r
-{$endif}\r
-{$ifndef win32}\r
-  {$include unixstuff.inc}\r
-{$endif}\r
-{$include ltimevalstuff.inc}\r
-\r
-\r
-{!!! added sleep call -beware}\r
-procedure sleep(i:integer);\r
-var\r
-  tv:ttimeval;\r
-begin\r
-  {$ifdef win32}\r
-    windows.sleep(i);\r
-  {$else}\r
-    tv.tv_sec := i div 1000;\r
-    tv.tv_usec := (i mod 1000) * 1000;\r
-    select(0,nil,nil,nil,@tv);\r
-  {$endif}\r
-end;\r
-\r
-destructor tlcomponent.destroy;\r
-begin\r
-  disconnecttasks(self);\r
-  inherited destroy;\r
-end;\r
-\r
-\r
-\r
-\r
-procedure tlcomponent.release;\r
-begin\r
-  released := true;\r
-end;\r
-\r
-procedure tlasio.release;\r
-begin\r
-  asinreleaseflag := true;\r
-  inherited release;\r
-end;\r
-\r
-procedure tlasio.doreceiveloop;\r
-begin\r
-  if recvq.size = 0 then exit;\r
-  if assigned(ondataavailable) then ondataavailable(self,0);\r
-  if not (wsonoreceiveloop in componentoptions) then\r
-  if recvq.size > 0 then tltask.create(self.doreceiveloop,self,0,0);\r
-end;\r
-\r
-function tlasio.receivestr;\r
-begin\r
-  setlength(result,recvq.size);\r
-  receive(@result[1],length(result));\r
-end;\r
-\r
-function tlasio.receive(Buf:Pointer;BufSize:integer):integer;\r
-var\r
-  i,a,b:integer;\r
-  p:pointer;\r
-begin\r
-  i := bufsize;\r
-  if recvq.size < i then i := recvq.size;\r
-  a := 0;\r
-  while (a < i) do begin\r
-    b := recvq.get(p,i-a);\r
-    move(p^,buf^,b);\r
-    inc(taddrint(buf),b);\r
-    recvq.del(b);\r
-    inc(a,b);\r
-  end;\r
-  result := i;\r
-  if wsonoreceiveloop in componentoptions then begin\r
-    if recvq.size = 0 then eventcore.rmasterset(fdhandlein,false);\r
-  end;\r
-end;\r
-\r
-constructor tlasio.create;\r
-begin\r
-  inherited create(AOwner);\r
-  sendq := tfifo.create;\r
-  recvq := tfifo.create;\r
-  state := wsclosed;\r
-  fdhandlein := -1;\r
-  fdhandleout := -1;\r
-  nextasin := firstasin;\r
-  prevasin := nil;\r
-  if assigned(nextasin) then nextasin.prevasin := self;\r
-  firstasin := self;\r
-\r
-  released := false;\r
-end;\r
-\r
-destructor tlasio.destroy;\r
-begin\r
-  destroying := true;\r
-  if state <> wsclosed then close;\r
-  if prevasin <> nil then begin\r
-    prevasin.nextasin := nextasin;\r
-  end else begin\r
-    firstasin := nextasin;\r
-  end;\r
-  if nextasin <> nil then begin\r
-    nextasin.prevasin := prevasin;\r
-  end;\r
-  recvq.destroy;\r
-  sendq.destroy;\r
-  inherited destroy;\r
-end;\r
-\r
-procedure tlasio.close;\r
-begin\r
-  internalclose(0);\r
-end;\r
-\r
-procedure tlasio.abort;\r
-begin\r
-  close;\r
-end;\r
-\r
-procedure tlasio.fdcleanup;\r
-begin\r
-  if fdhandlein <> -1 then begin\r
-    eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster)\r
-  end;\r
-  if fdhandleout <> -1 then begin\r
-    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster)\r
-  end;\r
-  if fdhandlein=fdhandleout then begin\r
-    if fdhandlein <> -1 then begin\r
-      myfdclose(fdhandlein);\r
-    end;\r
-  end else begin\r
-    if fdhandlein <> -1 then begin\r
-      myfdclose(fdhandlein);\r
-    end;\r
-    if fdhandleout <> -1 then begin\r
-      myfdclose(fdhandleout);\r
-    end;\r
-  end;\r
-  fdhandlein := -1;\r
-  fdhandleout := -1;\r
-end;\r
-\r
-procedure tlasio.internalclose(error:word);\r
-begin\r
-  if state<>wsclosed then begin\r
-    if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');\r
-    eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);\r
-    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
-\r
-    if closehandles then begin\r
-      {$ifndef win32}\r
-        //anyone remember why this is here? --plugwash\r
-        fcntl(fdhandlein,F_SETFL,0);\r
-      {$endif}\r
-      myfdclose(fdhandlein);\r
-      if fdhandleout <> fdhandlein then begin\r
-        {$ifndef win32}\r
-          fcntl(fdhandleout,F_SETFL,0);\r
-        {$endif}\r
-        myfdclose(fdhandleout);\r
-      end;\r
-      eventcore.setfdreverse(fdhandlein,nil);\r
-      eventcore.setfdreverse(fdhandleout,nil);\r
-\r
-      fdhandlein := -1;\r
-      fdhandleout := -1;\r
-    end;\r
-    state := wsclosed;\r
-\r
-    if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error);\r
-  end;\r
-  sendq.del(maxlongint);\r
-end;\r
-\r
-\r
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}\r
-{ All exceptions *MUST* be handled. If an exception is not handled, the     }\r
-{ application will most likely be shut down !                               }\r
-procedure tlasio.HandleBackGroundException(E: Exception);\r
-var\r
-  CanAbort : Boolean;\r
-begin\r
-  CanAbort := TRUE;\r
-  { First call the error event handler, if any }\r
-  if Assigned(OnBgException) then begin\r
-    try\r
-      OnBgException(Self, E, CanAbort);\r
-    except\r
-    end;\r
-  end;\r
-  { Then abort the socket }\r
-  if CanAbort then begin\r
-    try\r
-      close;\r
-    except\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure tlasio.sendstr(const str : string);\r
-begin\r
-  putstringinsendbuffer(str);\r
-  sendflush;\r
-end;\r
-\r
-procedure tlasio.putstringinsendbuffer(const newstring : string);\r
-begin\r
-  if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));\r
-end;\r
-\r
-function tlasio.send(data:pointer;len:integer):integer;\r
-begin\r
-  if state <> wsconnected then begin\r
-    result := -1;\r
-    exit;\r
-  end;\r
-  if len < 0 then len := 0;\r
-  result := len;\r
-  putdatainsendbuffer(data,len);\r
-  sendflush;\r
-end;\r
-\r
-\r
-procedure tlasio.putdatainsendbuffer(data:pointer;len:integer);\r
-begin\r
-  sendq.add(data,len);\r
-end;\r
-\r
-function tlasio.sendflush : integer;\r
-var\r
-  lensent : integer;\r
-  data:pointer;\r
-//  fdstestr : fdset;\r
-//  fdstestw : fdset;\r
-begin\r
-  if state <> wsconnected then exit;\r
-\r
-  lensent := sendq.get(data,2920);\r
-  if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;\r
-\r
-  if result = -1 then lensent := 0 else lensent := result;\r
-\r
-  //sendq := copy(sendq,lensent+1,length(sendq)-lensent);\r
-  sendq.del(lensent);\r
-\r
-  //fd_clr(fdhandleout,fdsw); // this prevents the socket being closed by a write\r
-                            // that sends nothing because a previous socket has\r
-                            // slready flushed this socket when the message loop\r
-                            // reaches it\r
-//  if sendq.size > 0 then begin\r
-    eventcore.wmasterset(fdhandleout);//fd_set(fdhandleout,fdswmaster);\r
-//  end else begin\r
-//    wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
-//  end;\r
-  if result > 0 then begin\r
-    if assigned(onsenddata) then onsenddata(self,result);\r
-//    if sendq.size=0 then if assigned(ondatasent) then begin\r
-//      tltask.create(self.dodatasent,self,0,0);\r
-//      //begin test code\r
-//      fd_zero(fdstestr);\r
-//      fd_zero(fdstestw);\r
-//      fd_set(fdhandlein,fdstestr);\r
-//      fd_set(fdhandleout,fdstestw);\r
-//      select(maxs,@fdstestr,@fdstestw,nil,0);\r
-//      writeln(fd_isset(fdhandlein,fdstestr),' ',fd_isset(fdhandleout,fdstestw));\r
-//      //end test code\r
-//    \r
-//    end;\r
-    writtenthiscycle := true;\r
-  end;\r
-end;\r
-\r
-procedure tlasio.dupnowatch(invalue:longint);\r
-begin\r
-  {  debugout('invalue='+inttostr(invalue));}\r
-  //readln;\r
-  if state<> wsclosed then close;\r
-  fdhandlein := invalue;\r
-  fdhandleout := invalue;\r
-  eventcore.setfdreverse(fdhandlein,self);\r
-  {$ifndef win32}\r
-    fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);\r
-  {$endif}\r
-  state := wsconnected;\r
-\r
-end;\r
-\r
-\r
-procedure tlasio.dup(invalue:longint);\r
-begin\r
-  dupnowatch(invalue);\r
-  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);\r
-  eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
-end;\r
-\r
-\r
-procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);\r
-var\r
-  sendflushresult : integer;\r
-  tempbuf:array[0..receivebufsize-1] of byte;\r
-begin\r
-  if (state=wsconnected) and writetrigger then begin\r
-    //writeln('write trigger');\r
-\r
-    if (sendq.size >0) then begin\r
-\r
-      sendflushresult := sendflush;\r
-      if (sendflushresult <= 0) and (not writtenthiscycle) then begin\r
-        if sendflushresult=0 then begin // linuxerror := 0;\r
-          internalclose(0);\r
-\r
-        end else begin\r
-          internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
-        end;\r
-      end;\r
-\r
-    end else begin\r
-      //everything is sent fire off ondatasent event\r
-      if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
-      if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0);\r
-    end;\r
-    if assigned(onfdwrite) then onfdwrite(self,0);\r
-  end;\r
-  writtenthiscycle := false;\r
-  if (state =wsconnected) and readtrigger then begin\r
-    if recvq.size=0 then begin\r
-      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));\r
-      if (numread=0) and (not mustrefreshfds) then begin\r
-        {if i remember correctly numread=0 is caused by eof\r
-        if this isn't dealt with then you get a cpu eating infinite loop\r
-        however if onsessionconencted has called processmessages that could\r
-        cause us to drop to here with an empty recvq and nothing left to read\r
-        and we don't want that to cause the socket to close}\r
-\r
-        internalclose(0);\r
-      end else if (numread=-1) then begin\r
-        numread := 0;\r
-        internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
-      end else if numread > 0 then recvq.add(@tempbuf,numread);\r
-    end;\r
-\r
-    if recvq.size > 0 then begin\r
-      if wsonoreceiveloop in componentoptions then eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster);\r
-      if assigned(ondataavailable) then ondataAvailable(self,0);\r
-      if not (wsonoreceiveloop in componentoptions) then if recvq.size > 0 then\r
-      tltask.create(self.doreceiveloop,self,0,0);\r
-    end;\r
-    //until (numread = 0) or (currentsocket.state<>wsconnected);\r
-{    debugout('inner loop complete');}\r
-  end;\r
-end;\r
-\r
-{$ifndef win32}\r
-  procedure tlasio.flush;\r
-  var\r
-    fds : fdset;\r
-  begin\r
-    fd_zero(fds);\r
-    fd_set(fdhandleout,fds);\r
-    while sendq.size>0 do begin\r
-      select(fdhandleout+1,nil,@fds,nil,nil);\r
-      if sendflush <= 0 then exit;\r
-    end;\r
-  end;\r
-{$endif}\r
-\r
-procedure tlasio.dodatasent(wparam,lparam:longint);\r
-begin\r
-  if assigned(ondatasent) then ondatasent(self,lparam);\r
-end;\r
-\r
-procedure tlasio.deletebuffereddata;\r
-begin\r
-  sendq.del(maxlongint);\r
-end;\r
-\r
-procedure tlasio.sinkdata(sender:tobject;error:word);\r
-begin\r
-  tlasio(sender).recvq.del(maxlongint);\r
-end;\r
-\r
-{$ifndef win32}\r
-  procedure tltimer.resettimes;\r
-  begin\r
-    gettimeofday(nextts);\r
-    {if not initialevent then} tv_add(nextts,interval);\r
-  end;\r
-{$endif}\r
-\r
-{procedure tltimer.setinitialevent(newvalue : boolean);\r
-begin\r
-  if newvalue <> finitialevent then begin\r
-    finitialevent := newvalue;\r
-    if assigned(timerwrapperinterface) then begin\r
-      timerwrapperinterface.setinitialevent(wrappedtimer,newvalue);\r
-    end else begin\r
-      resettimes;\r
-    end;\r
-  end;\r
-end;}\r
-\r
-procedure tltimer.setontimer(newvalue:tnotifyevent);\r
-begin\r
-  if @newvalue <> @fontimer then begin\r
-    fontimer := newvalue;\r
-    if assigned(timerwrapperinterface) then begin\r
-      timerwrapperinterface.setontimer(wrappedtimer,newvalue);\r
-    end else begin\r
-\r
-    end;\r
-  end;\r
-\r
-end;\r
-\r
-\r
-procedure tltimer.setenabled(newvalue : boolean);\r
-begin\r
-  if newvalue <> fenabled then begin\r
-    fenabled := newvalue;\r
-    if assigned(timerwrapperinterface) then begin\r
-      timerwrapperinterface.setenabled(wrappedtimer,newvalue);\r
-    end else begin\r
-      {$ifdef win32}\r
-        raise exception.create('non wrapper timers are not permitted on windows');\r
-      {$else}\r
-        resettimes;\r
-      {$endif}\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure tltimer.setinterval(newvalue:integer);\r
-begin\r
-  if newvalue <> finterval then begin\r
-    finterval := newvalue;\r
-    if assigned(timerwrapperinterface) then begin\r
-      timerwrapperinterface.setinterval(wrappedtimer,newvalue);\r
-    end else begin\r
-      {$ifdef win32}\r
-        raise exception.create('non wrapper timers are not permitted on windows');\r
-      {$else}\r
-        resettimes;\r
-      {$endif}\r
-    end;\r
-  end;\r
-\r
-end;\r
-\r
-\r
-\r
-\r
-constructor tltimer.create;\r
-begin\r
-  inherited create(AOwner);\r
-  if assigned(timerwrapperinterface) then begin\r
-    wrappedtimer := timerwrapperinterface.createwrappedtimer;\r
-  end else begin\r
-\r
-\r
-    nexttimer := firsttimer;\r
-    prevtimer := nil;\r
-\r
-    if assigned(nexttimer) then nexttimer.prevtimer := self;\r
-    firsttimer := self;\r
-  end;\r
-  interval := 1000;\r
-  enabled := true;\r
-  released := false;\r
-\r
-end;\r
-\r
-destructor tltimer.destroy;\r
-begin\r
-  if assigned(timerwrapperinterface) then begin\r
-    wrappedtimer.free;\r
-  end else begin\r
-    if prevtimer <> nil then begin\r
-      prevtimer.nexttimer := nexttimer;\r
-    end else begin\r
-      firsttimer := nexttimer;\r
-    end;\r
-    if nexttimer <> nil then begin\r
-      nexttimer.prevtimer := prevtimer;\r
-    end;\r
-    \r
-  end;\r
-  inherited destroy;\r
-end;\r
-\r
-constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  inherited create;\r
-  if assigned(onaddtask) then onaddtask(ahandler,aobj,awparam,alparam);\r
-  handler   := ahandler;\r
-  obj       := aobj;\r
-  wparam    := awparam;\r
-  lparam    := alparam;\r
-  {nexttask  := firsttask;\r
-  firsttask := self;}\r
-  if assigned(lasttask) then begin\r
-    lasttask.nexttask := self;\r
-  end else begin\r
-    firsttask := self;\r
-  end;\r
-  lasttask := self;\r
-  //ahandler(wparam,lparam);\r
-end;\r
-\r
-procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-\r
-  tltask.create(ahandler,aobj,awparam,alparam);\r
-end;\r
-\r
-\r
-\r
-\r
-{$ifndef nosignal}\r
-  procedure prepsigpipe;inline;\r
-  begin\r
-    starthandlesignal(sigpipe);\r
-    if not assigned(signalloopback) then begin\r
-      signalloopback := tlloopback.create(nil);\r
-      signalloopback.ondataAvailable := signalloopback.sinkdata;\r
-\r
-    end;\r
-\r
-  end;\r
-{$endif}\r
-\r
-procedure processtasks;//inline;\r
-var\r
-  temptask                : tltask   ;\r
-\r
-begin\r
-\r
-  if not assigned(currenttask) then begin\r
-    currenttask := firsttask;\r
-    firsttask := nil;\r
-    lasttask  := nil;\r
-  end;\r
-  while assigned(currenttask) do begin\r
-\r
-    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);\r
-    if assigned(currenttask) then begin\r
-      temptask := currenttask;\r
-      currenttask := currenttask.nexttask;\r
-      temptask.free;\r
-    end;\r
-    //writeln('processed a task');\r
-  end;\r
-\r
-end;\r
-\r
-\r
-\r
-\r
-procedure disconnecttasks(aobj:tobject);\r
-var\r
-  currenttasklocal : tltask ;\r
-  counter          : byte   ;\r
-begin\r
-  for counter := 0 to 1 do begin\r
-    if counter = 0 then begin\r
-      currenttasklocal := firsttask; //main list of tasks\r
-    end else begin\r
-      currenttasklocal := currenttask; //needed in case called from a task\r
-    end;\r
-    // note i don't bother to sestroy the links here as that will happen when\r
-    // the list of tasks is processed anyway\r
-    while assigned(currenttasklocal) do begin\r
-      if currenttasklocal.obj = aobj then begin\r
-        currenttasklocal.obj := nil;\r
-        currenttasklocal.handler := nil;\r
-      end;\r
-      currenttasklocal := currenttasklocal.nexttask;\r
-    end;\r
-  end;\r
-end;\r
-\r
-\r
-procedure processmessages;\r
-begin\r
-  eventcore.processmessages;\r
-end;\r
-procedure messageloop;\r
-begin\r
-  eventcore.messageloop;\r
-end;\r
-\r
-procedure exitmessageloop;\r
-begin\r
-  eventcore.exitmessageloop;\r
-end;\r
-\r
-function tlasio.RealSend(Data : Pointer; Len : Integer) : Integer;\r
-begin\r
-  result := myfdwrite(fdhandleout,data^,len);\r
-  if (result > 0) and assigned(onsenddata) then onsenddata(self,result);\r
-  eventcore.wmasterset(fdhandleout);\r
-end;\r
-{$ifndef win32}\r
-  procedure tlasio.myfdclose(fd : integer);\r
-  begin\r
-    fdclose(fd);\r
-  end;\r
-  function tlasio.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;\r
-  begin\r
-    result := fdwrite(fd,buf,size);\r
-  end;\r
-\r
-  function tlasio.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;\r
-  begin\r
-    result := fdread(fd,buf,size);\r
-  end;\r
-\r
-\r
-{$endif}\r
-\r
-\r
-begin\r
-  firstasin := nil;\r
-  firsttask := nil;\r
-  \r
-\r
-  {$ifndef nosignal}\r
-    signalloopback := nil;\r
-  {$endif}\r
-end.\r
-\r
-\r
-\r
-\r
-\r

diff --git a/httpserver_20080306/lcoregtklaz.pas b/httpserver_20080306/lcoregtklaz.pas
deleted file mode 100755 (executable)
index bbf4418..0000000
--- a/httpserver_20080306/lcoregtklaz.pas
+++ /dev/null
@@ -1,142 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green
-  For conditions of distribution and use, see copyright notice in zlib_license.txt
-  which is included in the package
-  ----------------------------------------------------------------------------- }
-      \r
-unit lcoregtklaz;\r
-{$mode delphi}\r
-interface\r
-       \r
-uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;\r
-//procedure lcoregtklazrun;\r
-const\r
-  G_IO_IN=1;\r
-  G_IO_OUT=4;\r
-  G_IO_PRI=2;\r
-  G_IO_ERR=8;\r
-\r
-  G_IO_HUP=16;\r
-  G_IO_NVAL=32;\r
-type\r
-  tlaztimerwrapperinterface=class(ttimerwrapperinterface)\r
-  public\r
-    function createwrappedtimer : tobject;override;\r
-//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;\r
-    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;\r
-  end;\r
-\r
-procedure lcoregtklazinit;\r
-implementation\r
-  uses\r
-    ExtCtrls;\r
-{$I unixstuff.inc}\r
-var\r
-  giochannels : array[0..absoloutemaxs] of pgiochannel;\r
-\r
-function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;\r
-// return true if we want the callback to stay\r
-var\r
-  fd                    : integer ;\r
-  fdsrlocal , fdswlocal : fdset   ;\r
-  currentasio           : tlasio  ;\r
-begin\r
-  fd := g_io_channel_unix_get_fd(source);\r
-  fd_zero(fdsrlocal);\r
-  fd_set(fd,fdsrlocal);\r
-  fdswlocal := fdsrlocal;\r
-  select(fd+1,@fdsrlocal,@fdswlocal,nil,0);\r
-  if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin\r
-    currentasio := fdreverse[fd];\r
-    if assigned(currentasio) then begin\r
-      currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));\r
-    end else begin\r
-      rmasterclr(fd);\r
-      wmasterclr(fd);\r
-    end;\r
-  end;\r
-  case condition of\r
-    G_IO_IN : begin\r
-      result := rmasterisset(fd);\r
-    end;\r
-    G_IO_OUT : begin\r
-      result := wmasterisset(fd);\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure gtkrmasterset(fd : integer);\r
-begin\r
-  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
-  g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);\r
-end;\r
-\r
-procedure gtkrmasterclr(fd: integer);\r
-begin\r
-end;\r
-  \r
-procedure gtkwmasterset(fd : integer);\r
-begin\r
-  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);\r
-  g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);\r
-end;\r
-\r
-procedure gtkwmasterclr(fd: integer);\r
-begin\r
-end;\r
-\r
-type\r
-  tsc = class\r
-    procedure dotasksandsink(sender:tobject;error:word);\r
-  end;\r
-var\r
-  taskloopback : tlloopback;\r
-  sc           : tsc;\r
-procedure tsc.dotasksandsink(sender:tobject;error:word);\r
-begin\r
-  with tlasio(sender) do begin\r
-    sinkdata(sender,error);\r
-    processtasks;\r
-  end;\r
-end;\r
-procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  taskloopback.sendstr(' ');\r
-  \r
-end;\r
-\r
-procedure lcoregtklazinit;\r
-begin\r
-  onrmasterset := gtkrmasterset;\r
-  onrmasterclr := gtkrmasterclr;\r
-  onwmasterset := gtkwmasterset;\r
-  onwmasterclr := gtkwmasterclr;\r
-  onaddtask := gtkaddtask;\r
-  taskloopback := tlloopback.create(nil);\r
-  taskloopback.ondataavailable := sc.dotasksandsink;\r
-  timerwrapperinterface := tlaztimerwrapperinterface.create(nil);\r
-end;\r
-\r
-function tlaztimerwrapperinterface.createwrappedtimer : tobject;\r
-begin\r
-  result := ttimer.create(nil);\r
-end;\r
-procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);\r
-begin\r
-  ttimer(wrappedtimer).ontimer := newvalue;\r
-end;\r
-procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);\r
-begin\r
-  ttimer(wrappedtimer).enabled := newvalue;\r
-end;\r
-\r
-\r
-procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);\r
-begin\r
-  ttimer(wrappedtimer).interval := newvalue;\r
-end;\r
-\r
-\r
-end.\r
-\r

diff --git a/httpserver_20080306/lcoreselect.pas b/httpserver_20080306/lcoreselect.pas
deleted file mode 100755 (executable)
index 0369448..0000000
--- a/httpserver_20080306/lcoreselect.pas
+++ /dev/null
@@ -1,391 +0,0 @@
-{lsocket.pas}\r
-\r
-{io and timer code by plugwash}\r
-\r
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-\r
-unit lcoreselect;\r
-\r
-\r
-interface\r
-uses\r
-  fd_utils;\r
-var\r
-  maxs                                  : longint    ;\r
-  exitloopflag                          : boolean    ; {if set by app, exit mainloop}\r
-\r
-function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
-function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}\r
-\r
-implementation\r
-uses\r
-  lcore,sysutils,\r
-  {$ifdef VER1_0}\r
-    linux,\r
-  {$else}\r
-    baseunix,unix,\r
-  {$endif}\r
-  classes,pgtypes,bfifo,\r
-  {$ifndef nosignal}\r
-    lsignal;\r
-  {$endif}\r
-\r
-{$include unixstuff.inc}\r
-{$include ltimevalstuff.inc}\r
-var\r
-  fdreverse:array[0..absoloutemaxs] of tlasio;\r
-type\r
-  tselecteventcore=class(teventcore)\r
-    public\r
-      procedure processmessages; override;\r
-      procedure messageloop; override;\r
-      procedure exitmessageloop;override;\r
-      procedure setfdreverse(fd : integer;reverseto : tlasio); override;\r
-      procedure rmasterset(fd : integer;islistensocket : boolean); override;\r
-      procedure rmasterclr(fd: integer); override;\r
-      procedure wmasterset(fd : integer); override;\r
-      procedure wmasterclr(fd: integer); override;\r
-    end;\r
-\r
-procedure processtimers;inline;\r
-var\r
-  tv           ,tvnow     : ttimeval ;\r
-  currenttimer            : tltimer   ;\r
-  temptimer               : tltimer  ;\r
-\r
-begin\r
-  gettimeofday(tvnow);\r
-  currenttimer := firsttimer;\r
-  while assigned(currenttimer) do begin\r
-    //writeln(currenttimer.enabled);\r
-    if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin\r
-      //if assigned(currenttimer.ontimer) then begin\r
-      //  if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);\r
-      //  currenttimer.initialdone := true;\r
-      //end;\r
-      if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);\r
-      currenttimer.nextts := timeval(tvnow);\r
-      tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);\r
-    end;\r
-    temptimer := currenttimer;\r
-    currenttimer := currenttimer.nexttimer;\r
-    if temptimer.released then temptimer.free;\r
-  end;\r
-end;\r
-\r
-procedure processasios(var fdsr,fdsw:fdset);//inline;\r
-var\r
-  currentsocket : tlasio  ;\r
-  tempsocket    : tlasio  ;\r
-  socketcount   : integer ; // for debugging perposes :)\r
-  dw,bt:integer;\r
-begin\r
-{  inc(lcoretestcount);}\r
-\r
-    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
-    //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;\r
-\r
-\r
-  {------- test optimised loop}\r
-  socketcount := 0;\r
-  for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin\r
-    for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin\r
-      inc(socketcount);\r
-      currentsocket := fdreverse[dw shl 5 or bt];\r
-      {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');\r
-      if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}\r
-      {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}\r
-      if not assigned(currentsocket) then begin\r
-        fdclose(dw shl 5 or bt);\r
-        continue\r
-      end;\r
-      if currentsocket.fdhandlein < 0 then begin\r
-        fdclose(dw shl 5 or bt);\r
-        continue\r
-      end;\r
-      try\r
-        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));\r
-      except\r
-        on E: exception do begin\r
-          currentsocket.HandleBackGroundException(e);\r
-        end;\r
-      end;\r
-\r
-      if mustrefreshfds then begin\r
-        if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin\r
-          fd_zero(fdsr);\r
-          fd_zero(fdsw);\r
-        end;\r
-      end;\r
-    end;\r
-  end;\r
-\r
-  if asinreleaseflag then begin\r
-    asinreleaseflag := false;\r
-    currentsocket := firstasin;\r
-    while assigned(currentsocket) do begin\r
-      tempsocket := currentsocket;\r
-      currentsocket := currentsocket.nextasin;\r
-      if tempsocket.released then begin\r
-        tempsocket.free;\r
-      end;\r
-    end;\r
-  end;\r
-  {\r
-  !!! issues:\r
-  - sockets which are released may not be freed because theyre never processed by the loop\r
-  made new code for handling this, using asinreleaseflag\r
-\r
-  - when/why does the mustrefreshfds select apply, sheck if i did it correctly?\r
-\r
-  - what happens if calling handlefdtrigger for a socket which does not have an event\r
-  }\r
-  {------- original loop}\r
-\r
-  (*\r
-  currentsocket := firstasin;\r
-  socketcount := 0;\r
-  while assigned(currentsocket) do begin\r
-    if mustrefreshfds then begin\r
-      if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin\r
-        fd_zero(fdsr);\r
-        fd_zero(fdsw);\r
-      end;\r
-    end;\r
-    try\r
-      if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin\r
-        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));\r
-      end;\r
-    except\r
-      on E: exception do begin\r
-        currentsocket.HandleBackGroundException(e);\r
-      end;\r
-    end;\r
-    tempsocket := currentsocket;\r
-    currentsocket := currentsocket.nextasin;\r
-    inc(socketcount);\r
-    if tempsocket.released then begin\r
-      tempsocket.free;\r
-    end;\r
-  end; *)\r
-{  debugout('socketcount='+inttostr(socketcount));}\r
-end;\r
-\r
-procedure tselecteventcore.processmessages;\r
-var\r
-  fdsr         , fdsw : fdset   ;\r
-  selectresult        : longint ;\r
-begin\r
-  mustrefreshfds := false;\r
-  {$ifndef nosignal}\r
-    prepsigpipe;\r
-  {$endif}\r
-  selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);\r
-  while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;\r
-\r
-    processtasks;\r
-    processtimers;\r
-    if selectresult > 0 then begin\r
-      processasios(fdsr,fdsw);\r
-    end;\r
-    selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);\r
-\r
-  end;\r
-  mustrefreshfds := true;\r
-end;\r
-\r
-\r
-var\r
-  FDSR , FDSW : fdset;\r
-\r
-Function  doSelect(timeOut:PTimeVal):longint;//inline;\r
-var\r
-  localtimeval : ttimeval;\r
-  maxslocal    : integer;\r
-begin\r
-  //unblock signals\r
-  //zeromemory(@sset,sizeof(sset));\r
-  //sset[0] := ;\r
-  fdsr := getfdsrmaster;\r
-  fdsw := getfdswmaster;\r
-\r
-  if assigned(firsttask) then begin\r
-    localtimeval.tv_sec  := 0;\r
-    localtimeval.tv_usec := 0;\r
-    timeout := @localtimeval;\r
-  end;\r
-\r
-  maxslocal := maxs;\r
-  mustrefreshfds := false;\r
-{  debugout('about to call select');}\r
-  {$ifndef nosignal}\r
-    sigprocmask(SIG_UNBLOCK,@blockset,nil);\r
-  {$endif}\r
-  result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);\r
-  if result <= 0 then begin\r
-    fd_zero(FDSR);\r
-    fd_zero(FDSW);\r
-    if result=-1 then begin\r
-      if linuxerror = SYS_EINTR then begin\r
-        // we received a signal it's not a problem\r
-      end else begin\r
-        raise esocketexception.create('select returned error '+inttostr(linuxerror));\r
-      end;\r
-    end;\r
-  end;\r
-  {$ifndef nosignal}\r
-    sigprocmask(SIG_BLOCK,@blockset,nil);\r
-  {$endif}\r
-{  debugout('select complete');}\r
-end;\r
-\r
-procedure tselecteventcore.exitmessageloop;\r
-begin\r
-  exitloopflag := true\r
-end;\r
-\r
-\r
-\r
-procedure tselecteventcore.messageloop;\r
-var\r
-  tv           ,tvnow     : ttimeval ;\r
-  currenttimer            : tltimer  ;\r
-  selectresult:integer;\r
-begin\r
-  {$ifndef nosignal}\r
-    prepsigpipe;\r
-  {$endif}\r
-  {currentsocket := firstasin;\r
-  if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
-  repeat\r
-\r
-    if currentsocket.state = wsconnected then currentsocket.sendflush;\r
-    currentsocket := currentsocket.nextasin;\r
-  until not assigned(currentsocket);}\r
-\r
-\r
-  repeat\r
-\r
-    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
-    if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;\r
-    {fd_zero(FDSR);\r
-    fd_zero(FDSW);\r
-    currentsocket := firstasin;\r
-    if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
-\r
-    repeat\r
-      if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);\r
-      if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);\r
-      if currentsocket is tlsocket then begin\r
-         if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);\r
-      end;\r
-      tempsocket := currentsocket;\r
-      currentsocket := currentsocket.nextasin;\r
-      if tempsocket.released then begin\r
-        tempsocket.free;\r
-      end;\r
-    until not assigned(currentsocket);\r
-    }\r
-    processtasks;\r
-    //currenttask := nil;\r
-    {beware}\r
-    //if assigned(firsttimer) then begin\r
-    //  tv.tv_sec := maxlongint;\r
-    tv := tv_invalidtimebig;\r
-    currenttimer := firsttimer;\r
-    while assigned(currenttimer) do begin\r
-      if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;\r
-      currenttimer := currenttimer.nexttimer;\r
-    end;\r
-\r
-\r
-    if tv_compare(tv,tv_invalidtimebig) then begin    \r
-      //writeln('no timers active');\r
-      if exitloopflag then break;\r
-{    sleep(10);}\r
-      selectresult := doselect(nil);\r
-\r
-    end else begin\r
-      gettimeofday(tvnow);\r
-      tv_substract(tv,tvnow);\r
-\r
-      //writeln('timers active');\r
-      if tv.tv_sec < 0 then begin\r
-        tv.tv_sec := 0;\r
-        tv.tv_usec := 0; {0.1 sec}\r
-      end;\r
-      if exitloopflag then break;\r
-{    sleep(10);}\r
-      selectresult := doselect(@tv);\r
-      processtimers;\r
-\r
-    end;\r
-    if selectresult > 0 then processasios(fdsr,fdsw);\r
-    {!!!only call processasios if select has asio events -beware}\r
-\r
-    {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}\r
-  until false;\r
-end;\r
-\r
-var\r
-  fdsrmaster , fdswmaster               : fdset      ;\r
-\r
-procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);\r
-begin\r
-  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');\r
-  if fd > maxs then maxs := fd;\r
-  if fd_isset(fd,fdsrmaster) then exit;\r
-  fd_set(fd,fdsrmaster);\r
-\r
-end;\r
-\r
-procedure tselecteventcore.rmasterclr(fd: integer);\r
-begin\r
-  if not fd_isset(fd,fdsrmaster) then exit;\r
-  fd_clr(fd,fdsrmaster);\r
-\r
-end;\r
-\r
-\r
-procedure tselecteventcore.wmasterset(fd : integer);\r
-begin\r
-  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');\r
-  if fd > maxs then maxs := fd;\r
-\r
-  if fd_isset(fd,fdswmaster) then exit;\r
-  fd_set(fd,fdswmaster);\r
-\r
-end;\r
-\r
-procedure tselecteventcore.wmasterclr(fd: integer);\r
-begin\r
-  if not fd_isset(fd,fdswmaster) then exit;\r
-  fd_clr(fd,fdswmaster);\r
-end;\r
-\r
-procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);\r
-begin\r
-  fdreverse[fd] := reverseto;\r
-end;\r
-\r
-function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}\r
-begin\r
-  result := fdsrmaster;\r
-end;\r
-function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}\r
-begin\r
-  result := fdswmaster;\r
-end;\r
-\r
-\r
-begin\r
-  eventcore := tselecteventcore.create;\r
-\r
-  maxs := 0;\r
-  fd_zero(fdsrmaster);\r
-  fd_zero(fdswmaster);\r
-end.\r

diff --git a/httpserver_20080306/lcoretest.dpr b/httpserver_20080306/lcoretest.dpr
deleted file mode 100755 (executable)
index e9d1b0a..0000000
--- a/httpserver_20080306/lcoretest.dpr
+++ /dev/null
@@ -1,167 +0,0 @@
-program lcoretest;\r
-\r
-uses\r
-  lcore,\r
-  lsocket,\r
-  {$ifdef win32}\r
-    lcorewsaasyncselect in 'lcorewsaasyncselect.pas',\r
-  {$else}\r
-    lcoreselect,\r
-  {$endif}\r
-  dnsasync,\r
-  binipstuff,\r
-  dnssync;\r
-{$ifdef win32}\r
-  {$R *.RES}\r
-{$endif}\r
-\r
-type\r
-  tsc=class\r
-    procedure sessionavailable(sender: tobject;error : word);\r
-    procedure dataavailable(sender: tobject;error : word);\r
-    procedure sessionconnected(sender: tobject;error : word);\r
-    procedure taskrun(wparam,lparam:longint);\r
-    procedure timehandler(sender:tobject);\r
-    procedure dnsrequestdone(sender:tobject;error : word);\r
-    procedure sessionclosed(sender:tobject;error : word);\r
-  end;\r
-var\r
-  listensocket : tlsocket;\r
-  serversocket : tlsocket;\r
-  clientsocket : tlsocket;\r
-  sc : tsc;\r
-  task : tltask;\r
-procedure tsc.sessionavailable(sender: tobject;error : word);\r
-begin\r
-  writeln('received connection');\r
-  serversocket.dup(listensocket.accept);\r
-end;\r
-\r
-var\r
-  receivebuf : string;\r
-  receivecount : integer;\r
-procedure tsc.dataavailable(sender: tobject;error : word);\r
-var\r
-  receiveddata : string;\r
-  receivedon : string;\r
-begin\r
-  receiveddata := tlsocket(sender).receivestr;\r
-  if sender=clientsocket then begin\r
-    receivedon := 'client socket';\r
-  end else begin\r
-    receivedon := 'server socket';\r
-  end;\r
-  writeln('received data '+receiveddata+' on '+receivedon);\r
-  if sender=serversocket then begin\r
-    receivebuf := receivebuf+receiveddata;\r
-  end;\r
-  if receivebuf = 'hello world' then begin\r
-    receivebuf := '';\r
-    writeln('received hello world creating task');\r
-    task := tltask.create(sc.taskrun,nil,0,0);\r
-  end;\r
-  receivecount := receivecount +1;\r
-  if receivecount >50 then begin\r
-    writeln('received over 50 bits of data, pausing to let the operator take a look');\r
-    readln;\r
-    receivecount := 0;\r
-  end;\r
-\r
-end;\r
-\r
-procedure tsc.sessionconnected(sender: tobject;error : word);\r
-begin\r
-  if error=0 then begin\r
-    writeln('session is connected');\r
-    if clientsocket.addr = '127.0.0.1' then begin\r
-      clientsocket.sendstr('hello world');\r
-    end else begin\r
-      clientsocket.sendstr('get /'#13#10#13#10);\r
-    end;\r
-  end else begin\r
-    writeln('connect failed');\r
-  end;\r
-end;\r
-\r
-var\r
-  das : tdnsasync;\r
-\r
-procedure tsc.taskrun(wparam,lparam:longint);\r
-var\r
-  tempbinip : tbinip;\r
-  dummy : integer;\r
-begin\r
-  writeln('task ran');\r
-  writeln('closing client socket');\r
-  clientsocket.close;\r
-\r
-  writeln('looking up www.kame.net using dnsasync');\r
-  das := tdnsasync.Create(nil);\r
-  das.onrequestdone := sc.dnsrequestdone;\r
-  das.forwardfamily := af_inet6;
-  das.forwardlookup('www.kame.net');\r
-end;\r
-\r
-procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
-begin\r
-  writeln('www.kame.net resolved to '+das.dnsresult+' connecting client socket there');\r
-  clientsocket.addr := das.dnsresult;\r
-  clientsocket.port := '80';\r
-  clientsocket.connect;\r
-  das.free;\r
-end;\r
-\r
-procedure tsc.timehandler(sender:tobject);\r
-begin\r
-  //writeln('got timer event');\r
-end;\r
-procedure tsc.sessionclosed(sender:tobject;error : word);\r
-begin\r
-  Writeln('session closed with error ',error);\r
-end;\r
-var\r
-  timer : tltimer;\r
-  ipbin : tbinip;\r
-  dummy : integer;\r
-begin\r
-  ipbin := forwardlookup('invalid.domain',5);\r
-  writeln(ipbintostr(ipbin));\r
-\r
-  ipbin := forwardlookup('p10link.net',5);\r
-  writeln(ipbintostr(ipbin));\r
-\r
-  ipstrtobin('80.68.89.68',ipbin);\r
-  writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));\r
-\r
-  ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);\r
-  writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));\r
-  writeln('creating and setting up listen socket');\r
-  listensocket := tlsocket.create(nil);\r
-  listensocket.addr := '0.0.0.0';\r
-  listensocket.port := '12345';\r
-  listensocket.onsessionavailable := sc.sessionavailable;\r
-  writeln('listening');\r
-  listensocket.listen;\r
-  writeln('listen socket is number ', listensocket.fdhandlein);\r
-  writeln('creating and setting up server socket');\r
-  serversocket := tlsocket.create(nil);\r
-  serversocket.ondataavailable := sc.dataavailable;\r
-  writeln('creating and setting up client socket');\r
-  clientsocket := tlsocket.create(nil);\r
-  clientsocket.addr := {'::1';}'127.0.0.1';\r
-  clientsocket.port := '12345';\r
-  clientsocket.onsessionconnected := sc.sessionconnected;\r
-  clientsocket.ondataAvailable := sc.dataavailable;\r
-  clientsocket.onsessionclosed := sc.sessionclosed;\r
-  writeln('connecting');\r
-  clientsocket.connect;\r
-  writeln('client socket is number ',clientsocket.fdhandlein);\r
-  writeln('creating and setting up timer');\r
-  timer := tltimer.create(nil);\r
-  timer.interval := 1000;\r
-  timer.ontimer := sc.timehandler;\r
-  timer.enabled := true;\r
-  writeln('entering message loop');\r
-  messageloop;\r
-  writeln('exiting cleanly');\r
-end.\r

diff --git a/httpserver_20080306/lcorewsaasyncselect.pas b/httpserver_20080306/lcorewsaasyncselect.pas
deleted file mode 100755 (executable)
index a978c23..0000000
--- a/httpserver_20080306/lcorewsaasyncselect.pas
+++ /dev/null
@@ -1,216 +0,0 @@
-unit lcorewsaasyncselect;\r
-\r
-interface\r
-\r
-implementation\r
-uses wcore,lcore,bsearchtree,sysutils,windows,winsock,pgtypes,messages,classes;\r
-type\r
-  twineventcore=class(teventcore)\r
-  public\r
-    procedure processmessages; override;\r
-    procedure messageloop; override;\r
-    procedure exitmessageloop;override;\r
-    procedure setfdreverse(fd : integer;reverseto : tlasio); override;\r
-    procedure rmasterset(fd : integer;islistensocket : boolean); override;\r
-    procedure rmasterclr(fd: integer); override;\r
-    procedure wmasterset(fd : integer); override;\r
-    procedure wmasterclr(fd: integer); override;\r
-  end;\r
-const\r
-  wm_dotasks=wm_user+1;\r
-type\r
-  twintimerwrapperinterface=class(ttimerwrapperinterface)\r
-  public\r
-    function createwrappedtimer : tobject;override;\r
-//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;\r
-    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;\r
-    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;\r
-  end;\r
-\r
-procedure twineventcore.processmessages;\r
-begin\r
-  wcore.processmessages;//pass off to wcore\r
-end;\r
-procedure twineventcore.messageloop;\r
-begin\r
-  wcore.messageloop; //pass off to wcore\r
-end;\r
-procedure twineventcore.exitmessageloop;\r
-begin\r
-  wcore.exitmessageloop;\r
-end;\r
-var\r
-  fdreverse : thashtable;\r
-  fdwatches : thashtable;\r
-\r
-procedure twineventcore.setfdreverse(fd : integer;reverseto : tlasio);\r
-begin\r
-  if findtree(@fdreverse,inttostr(fd)) <> nil then deltree(@fdreverse,inttostr(fd));\r
-  if reverseto <> nil then addtree(@fdreverse,inttostr(fd),reverseto);\r
-end;\r
-\r
-var\r
-  hwndlcore : hwnd;\r
-procedure dowsaasyncselect(fd:integer; leventadd: integer; leventremove : integer);\r
-var\r
-  leventold : integer;\r
-  leventnew : integer;\r
-  wsaaresult : integer;\r
-begin\r
-  leventold := taddrint(findtree(@fdwatches,inttostr(fd)));\r
-  leventnew := leventold or leventadd;\r
-  leventnew := leventnew and not leventremove;\r
-  if leventold <> leventnew then begin\r
-    if leventold <> 0 then deltree(@fdwatches,inttostr(fd));\r
-    if leventnew <> 0 then addtree(@fdwatches,inttostr(fd),pointer(leventnew));\r
-  end;\r
-  wsaaresult := wsaasyncselect(fd,hwndlcore,wm_user,leventnew);\r
-\r
-end;\r
-\r
-\r
-//to allow detection of errors:\r
-//if we are asked to monitor for read or accept we also monitor for close\r
-//if we are asked to monitor for write we also monitor for connect\r
-\r
-\r
-procedure twineventcore.rmasterset(fd : integer;islistensocket : boolean);\r
-begin\r
-  if islistensocket then begin\r
-    //writeln('setting accept watch for socket number ',fd);\r
-    dowsaasyncselect(fd,FD_ACCEPT or FD_CLOSE,0);\r
-  end else begin\r
-    //writeln('setting read watch for socket number',fd);\r
-    dowsaasyncselect(fd,FD_READ or FD_CLOSE,0);\r
-  end;\r
-end;\r
-procedure twineventcore.rmasterclr(fd: integer);\r
-begin\r
-  //writeln('clearing read of accept watch for socket number ',fd);\r
-  dowsaasyncselect(fd,0,FD_ACCEPT or FD_READ or FD_CLOSE);\r
-end;\r
-procedure twineventcore.wmasterset(fd : integer);\r
-begin\r
-  dowsaasyncselect(fd,FD_WRITE or FD_CONNECT,0);\r
-end;\r
-\r
-procedure twineventcore.wmasterclr(fd: integer);\r
-begin\r
-  dowsaasyncselect(fd,0,FD_WRITE or FD_CONNECT);\r
-end;\r
-\r
-var\r
-  tasksoutstanding : boolean;\r
-\r
-function MyWindowProc(\r
-    ahWnd   : HWND;\r
-    auMsg   : Integer;\r
-    awParam : WPARAM;\r
-    alParam : LPARAM): Integer; stdcall;\r
-var\r
-  socket : integer;\r
-  event : integer;\r
-  error : integer;\r
-  readtrigger : boolean;\r
-  writetrigger : boolean;\r
-  lasio : tlasio;\r
-begin\r
-  //writeln('got a message');\r
-  Result := 0;  // This means we handled the message\r
-  if (ahwnd=hwndlcore) and (aumsg=wm_user) then begin\r
-    //writeln('it appears to be a response to our wsaasyncselect');\r
-    socket := awparam;\r
-    event := alparam and $FFFF;\r
-    error := alparam shr 16;\r
-    //writeln('socket=',socket,' event=',event,' error=',error);\r
-    readtrigger := false;\r
-    writetrigger := false;\r
-    lasio := findtree(@fdreverse,inttostr(socket));\r
-    if assigned(lasio) then begin\r
-      if (error <> 0) or ((event and FD_CLOSE) <> 0) then begin\r
-        if lasio.state = wsconnecting then begin\r
-          lasio.onsessionconnected(lasio,error);\r
-        end;\r
-        lasio.internalclose(error);\r
-      end else begin\r
-        if (event and (FD_READ or FD_ACCEPT)) <> 0 then readtrigger := true;\r
-        if (event and (FD_WRITE)) <> 0 then writetrigger := true;\r
-\r
-        if readtrigger or writetrigger then lasio.handlefdtrigger(readtrigger,writetrigger);\r
-      end;\r
-      dowsaasyncselect(socket,0,0); //reset watches\r
-    end;\r
-  end else if (ahwnd=hwndlcore) and (aumsg=wm_dotasks) then begin\r
-      //writeln('processing tasks');\r
-      tasksoutstanding := false;\r
-      processtasks;\r
-  end else begin\r
-      //writeln('passing unknown message to defwindowproc');\r
-      //not passing unknown messages on to defwindowproc will cause window\r
-      //creation to fail! --plugwash\r
-      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
-  end;\r
-\r
-end;\r
-\r
-procedure winaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  if not tasksoutstanding then PostMessage(hwndlcore,wm_dotasks,0,0);\r
-end;\r
-type\r
-  twcoretimer = wcore.tltimer;\r
-\r
-function twintimerwrapperinterface.createwrappedtimer : tobject;\r
-begin\r
-  result := twcoretimer.create(nil);\r
-end;\r
-procedure twintimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);\r
-begin\r
-  twcoretimer(wrappedtimer).ontimer := newvalue;\r
-end;\r
-procedure twintimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);\r
-begin\r
-  twcoretimer(wrappedtimer).enabled := newvalue;\r
-end;\r
-\r
-\r
-procedure twintimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);\r
-begin\r
-  twcoretimer(wrappedtimer).interval := newvalue;\r
-end;\r
-\r
-var\r
-  MyWindowClass : TWndClass = (style         : 0;\r
-                                 lpfnWndProc   : @MyWindowProc;\r
-                                 cbClsExtra    : 0;\r
-                                 cbWndExtra    : 0;\r
-                                 hInstance     : 0;\r
-                                 hIcon         : 0;\r
-                                 hCursor       : 0;\r
-                                 hbrBackground : 0;\r
-                                 lpszMenuName  : nil;\r
-                                 lpszClassName : 'lcoreClass');\r
-  GInitData: TWSAData;\r
-\r
-begin\r
-  eventcore := twineventcore.create;\r
-    if Windows.RegisterClass(MyWindowClass) = 0 then halt;\r
-  //writeln('about to create lcore handle, hinstance=',hinstance);\r
-  hwndlcore := CreateWindowEx(WS_EX_TOOLWINDOW,\r
-                               MyWindowClass.lpszClassName,\r
-                               '',        { Window name   }\r
-                               WS_POPUP,  { Window Style  }\r
-                               0, 0,      { X, Y          }\r
-                               0, 0,      { Width, Height }\r
-                               0,         { hWndParent    }\r
-                               0,         { hMenu         }\r
-                               HInstance, { hInstance     }\r
-                               nil);      { CreateParam   }\r
-  //writeln('lcore hwnd is ',hwndlcore);\r
-  //writeln('last error is ',GetLastError);\r
-  onaddtask := winaddtask;\r
-  timerwrapperinterface := twintimerwrapperinterface.create(nil);\r
-\r
-  WSAStartup($200, GInitData);\r
-end.\r

diff --git a/httpserver_20080306/lloopback.pas b/httpserver_20080306/lloopback.pas
deleted file mode 100755 (executable)
index da26263..0000000
--- a/httpserver_20080306/lloopback.pas
+++ /dev/null
@@ -1,30 +0,0 @@
-unit lloopback;\r
-\r
-interface\r
-uses lcore,classes;\r
-\r
-type\r
-  tlloopback=class(tlasio)\r
-  public\r
-    constructor create(aowner:tcomponent); override;\r
-  end;\r
-\r
-\r
-implementation\r
-uses
-  baseunix,unix;
-{$i unixstuff.inc}
-
-constructor tlloopback.create(aowner:tcomponent);\r
-begin\r
-  inherited create(aowner);\r
-  closehandles := true;\r
-  assignpipe(fdhandlein,fdhandleout);\r
-\r
-  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);\r
-  eventcore.wmasterclr(fdhandlein);//fd_clr(fdhandleout,fdswmaster);\r
-  eventcore.setfdreverse(fdhandlein,self);\r
-  eventcore.setfdreverse(fdhandleout,self);\r
-  state := wsconnected;\r
-end;\r
-end.\r

diff --git a/httpserver_20080306/lmessages.pas b/httpserver_20080306/lmessages.pas
deleted file mode 100755 (executable)
index 7bb73fd..0000000
--- a/httpserver_20080306/lmessages.pas
+++ /dev/null
@@ -1,656 +0,0 @@
-unit lmessages;\r
-//windows messages like system based on lcore tasks\r
-interface\r
-\r
-uses pgtypes,sysutils,bsearchtree,strings,syncobjs;\r
-\r
-type\r
-  lparam=taddrint;\r
-  wparam=taddrint;\r
-  thinstance=pointer;\r
-  hicon=pointer;\r
-  hcursor=pointer;\r
-  hbrush=pointer;\r
-  hwnd=qword; //window handles are monotonically increasing 64 bit integers,\r
-              //this should allow for a million windows per second for over half\r
-              //a million years!\r
-\r
-  twndproc=function(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
-\r
-\r
-  twndclass=record\r
-    style : dword;\r
-    lpfnwndproc : twndproc;\r
-    cbclsextra : integer;\r
-    cbwndextra : integer;\r
-    hinstance : thinstance;\r
-    hicon : hicon;\r
-    hcursor : hcursor;\r
-    hbrbackground : hbrush;\r
-    lpszmenuname : pchar;\r
-    lpszclassname : pchar;\r
-  end;\r
-  PWNDCLASS=^twndclass;\r
-  \r
-  UINT=dword;\r
-  WINBOOL = longbool;\r
-  tTIMERPROC = procedure (ahwnd:HWND; umsg:integer; idevent:taddrint;dwtime:taddrint);stdcall;\r
-  ATOM = pointer;\r
-  LPCSTR = pchar;\r
-  LPVOID = pointer;\r
-  HMENU = pointer;\r
-  HINST = pointer;\r
-\r
-  TPOINT = record \r
-    x : LONGint; \r
-    y : LONGint; \r
-  end; \r
-  \r
-  TMSG = record \r
-    hwnd : HWND; \r
-    message : UINT; \r
-    wParam : WPARAM; \r
-    lParam : LPARAM; \r
-    time : DWORD; \r
-    pt : TPOINT;\r
-  end; \r
-  THevent=TEventObject;\r
-const\r
-  WS_EX_TOOLWINDOW = $80;\r
-  WS_POPUP = longint($80000000);\r
-  hinstance=nil;\r
-  PM_REMOVE = 1;\r
-  WM_USER = 1024;\r
-  WM_TIMER = 275;\r
-  INFINITE = syncobjs.infinite;\r
-function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r
-function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;\r
-function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
-function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;\r
-function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;\r
-function DestroyWindow(ahWnd:HWND):WINBOOL;\r
-function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;\r
-function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
-function DispatchMessage(const lpMsg: TMsg): Longint;\r
-function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;\r
-function SetEvent(hEvent:THevent):WINBOOL;\r
-function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;\r
-function terminatethread(threadhandle : tthreadid;dummy:integer) : boolean;\r
-function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;\r
-function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;\r
-function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;\r
-\r
-procedure init;\r
-\r
-implementation\r
-uses\r
-  baseunix,unix,lcore;//,safewriteln;\r
-{$i unixstuff.inc}\r
-\r
-type\r
-  tmessageintransit = class\r
-    msg : tmsg;\r
-    next : tmessageintransit;\r
-  end;\r
-\r
-  tthreaddata = class\r
-    messagequeue : tmessageintransit;\r
-    messageevent : teventobject;\r
-    waiting : boolean;\r
-    lcorethread : boolean;\r
-    nexttimer : ttimeval;\r
-    threadid : integer;\r
-  end;\r
-  twindow=class\r
-    hwnd : hwnd;\r
-    extrawindowmemory : pointer;\r
-    threadid : tthreadid;\r
-    windowproc : twndproc;\r
-  end;\r
-\r
-var\r
-  structurelock : tcriticalsection;\r
-  threaddata : thashtable;\r
-  windowclasses : thashtable;\r
-  lcorelinkpipesend : integer;\r
-  lcorelinkpiperecv : tlasio;\r
-  windows : thashtable;\r
-  //I would rather things crash immediately\r
-  //if they use an insufficiant size type\r
-  //than crash after over four billion\r
-  //windows have been made ;)\r
-  nextwindowhandle : qword = $100000000;\r
-{$i ltimevalstuff.inc}\r
-\r
-//findthreaddata should only be called while holding the structurelock\r
-function findthreaddata(threadid : integer) : tthreaddata;\r
-begin\r
-  result := tthreaddata(findtree(@threaddata,inttostr(threadid)));\r
-  if result = nil then begin\r
-    result := tthreaddata.create;\r
-    result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));\r
-    result.nexttimer := tv_invalidtimebig;\r
-    result.threadid := threadid;\r
-    addtree(@threaddata,inttostr(threadid),result);\r
-  end;\r
-end;\r
-\r
-//deletethreaddataifunused should only be called while holding the structurelock\r
-procedure deletethreaddataifunused(athreaddata : tthreaddata);\r
-begin\r
-  //writeln('in deletethreaddataifunused');\r
-  if (athreaddata <> nil) then if (athreaddata.waiting=false) and (athreaddata.messagequeue=nil) and (athreaddata.lcorethread=false) and (athreaddata.nexttimer.tv_sec=tv_invalidtimebig.tv_sec) and (athreaddata.nexttimer.tv_usec=tv_invalidtimebig.tv_usec) then begin\r
-    //writeln('threaddata is unused, freeing messageevent');\r
-    athreaddata.messageevent.free;\r
-    //writeln('freeing thread data object');\r
-    athreaddata.free;\r
-    //writeln('deleting thread data object from hashtable');\r
-    deltree(@threaddata,inttostr(athreaddata.threadid));\r
-    //writeln('finished deleting thread data');\r
-  end else begin\r
-    //writeln('thread data is not unused');\r
-  end;\r
-end;\r
-\r
-function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;\r
-var\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := findtree(@windows,inttostr(ahwnd));\r
-    if window <> nil then begin\r
-      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;\r
-    end else begin\r
-      result := 0;\r
-    end;\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-end;\r
-\r
-function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;\r
-var\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := findtree(@windows,inttostr(ahwnd));\r
-    if window <> nil then begin\r
-      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;\r
-      paddrint(taddrint(window.extrawindowmemory)+nindex)^ := dwnewlong;\r
-    end else begin\r
-      result := 0;\r
-    end;\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-\r
-end;\r
-\r
-\r
-function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;\r
-begin\r
-  result := 0;\r
-end;\r
-\r
-function strdup(s:pchar) : pchar;\r
-begin\r
-  //swriteln('in strdup, about to allocate memory');\r
-  result := getmem(strlen(s)+1);\r
-  //swriteln('about to copy string');\r
-  strcopy(s,result);\r
-  //swriteln('leaving strdup');\r
-end;\r
-\r
-function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;\r
-var\r
-  storedwindowclass:pwndclass;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    //swriteln('in registerclass, about to check for duplicate window class');\r
-    storedwindowclass := findtree(@windowclasses, lpwndclass.lpszclassname);\r
-    if storedwindowclass <> nil then begin\r
-\r
-      if comparebyte(storedwindowclass^,lpwndclass,sizeof(twndclass)-sizeof(pchar)-sizeof(pchar)) <> 0 then begin\r
-        //swriteln('duplicate window class registered with different settings');\r
-        raise exception.create('duplicate window class registered with different settings');\r
-      end else begin\r
-        //swriteln('duplicate window class registered with same settings, tollerated');\r
-      end;\r
-    end else begin\r
-      //swriteln('about to allocate memory for new windowclass');\r
-      storedwindowclass := getmem(sizeof(twndclass));\r
-      //swriteln('about to copy windowclass from parameter');\r
-      move(lpwndclass,storedwindowclass^,sizeof(twndclass));\r
-      //swriteln('about to copy strings');\r
-      if lpwndclass.lpszmenuname <> nil then storedwindowclass.lpszmenuname := strdup(lpwndclass.lpszmenuname);\r
-      if lpwndclass.lpszclassname <> nil then storedwindowclass.lpszclassname := strdup(lpwndclass.lpszclassname);\r
-      //swriteln('about to add result to list of windowclasses');\r
-      addtree(@windowclasses,lpwndclass.lpszclassname,storedwindowclass);\r
-    end;\r
-    //swriteln('about to return result');\r
-    result := storedwindowclass;\r
-    //swriteln('leaving registerclass');\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-end;\r
-\r
-function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;\r
-var\r
-  wndclass : pwndclass;\r
-  tm : tthreadmanager;\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := twindow.create;\r
-    window.hwnd := nextwindowhandle;\r
-    result := window.hwnd;\r
-    nextwindowhandle := nextwindowhandle + 1;\r
-    addtree(@windows,inttostr(window.hwnd),window);\r
-    wndclass := findtree(@windowclasses,lpclassname);\r
-    window.extrawindowmemory := getmem(wndclass.cbwndextra);\r
-\r
-    getthreadmanager(tm);\r
-    window.threadid := tm.GetCurrentThreadId;\r
-    window.windowproc := wndclass.lpfnwndproc;\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-end;\r
-function DestroyWindow(ahWnd:HWND):WINBOOL;\r
-var\r
-  window : twindow;\r
-  windowthreaddata : tthreaddata;\r
-  currentmessage : tmessageintransit;\r
-  prevmessage : tmessageintransit;\r
-begin\r
-  //writeln('started to destroy window');\r
-  structurelock.acquire;\r
-  try\r
-    window := twindow(findtree(@windows,inttostr(ahwnd)));\r
-    if window <> nil then begin\r
-      freemem(window.extrawindowmemory);\r
-      //writeln('aboute to delete window from windows structure');\r
-      deltree(@windows,inttostr(ahwnd));\r
-      //writeln('deleted window from windows structure');\r
-      windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));\r
-\r
-      if windowthreaddata <> nil then begin\r
-        //writeln('found thread data scanning for messages to clean up');\r
-        currentmessage := windowthreaddata.messagequeue;\r
-        prevmessage := nil;\r
-        while currentmessage <> nil do begin\r
-          while (currentmessage <> nil) and (currentmessage.msg.hwnd = ahwnd) do begin\r
-            if prevmessage = nil then begin\r
-              windowthreaddata.messagequeue := currentmessage.next;\r
-            end else begin\r
-              prevmessage.next := currentmessage.next;\r
-            end;\r
-            currentmessage.free;\r
-            if prevmessage = nil then begin\r
-              currentmessage := windowthreaddata.messagequeue;\r
-            end else begin\r
-              currentmessage := prevmessage.next;\r
-            end;\r
-          end;\r
-          if currentmessage <> nil then begin\r
-            prevmessage := currentmessage;\r
-            currentmessage := currentmessage.next;\r
-          end;\r
-        end;\r
-        //writeln('deleting thread data structure if it is unused');\r
-        deletethreaddataifunused(windowthreaddata);\r
-      end else begin\r
-        //writeln('there is no thread data to search for messages to cleanup');\r
-      end;\r
-      //writeln('freeing window');\r
-      window.free;\r
-      result := true;\r
-    end else begin\r
-      result := false;\r
-    end;\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-  //writeln('window destroyed');\r
-end;\r
-\r
-\r
-\r
-function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;\r
-var\r
-  threaddata : tthreaddata;\r
-  message : tmessageintransit;\r
-  messagequeueend : tmessageintransit;\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := findtree(@windows,inttostr(hwnd));\r
-    if window <> nil then begin\r
-      threaddata := findthreaddata(window.threadid);\r
-      message := tmessageintransit.create;\r
-      message.msg.hwnd := hwnd;\r
-      message.msg.message := msg;\r
-      message.msg.wparam := wparam;\r
-      message.msg.lparam := lparam;\r
-      if threaddata.lcorethread then begin\r
-        //swriteln('posting message to lcore thread');\r
-        fdwrite(lcorelinkpipesend,message,sizeof(message));\r
-      end else begin\r
-        //writeln('posting message to non lcore thread');\r
-        if threaddata.messagequeue = nil then begin\r
-          threaddata.messagequeue := message;\r
-        end else begin\r
-          messagequeueend := threaddata.messagequeue;\r
-          while messagequeueend.next <> nil do begin\r
-            messagequeueend := messagequeueend.next;\r
-          end;\r
-          messagequeueend.next := message;\r
-        end;\r
-\r
-        //writeln('message added to queue');\r
-        if threaddata.waiting then threaddata.messageevent.setevent;\r
-      end;\r
-      result := true;\r
-    end else begin\r
-      result := false;\r
-    end;\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-\r
-end;\r
-\r
-function gettickcount : dword;\r
-var\r
-  result64: integer;\r
-  tv : ttimeval;\r
-begin\r
-  gettimeofday(tv);\r
-  result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);\r
-  result := result64;\r
-end;\r
-\r
-function DispatchMessage(const lpMsg: TMsg): Longint;\r
-var\r
-  timerproc : ttimerproc;\r
-  window : twindow;\r
-  windowproc : twndproc;\r
-begin\r
-  ////swriteln('in dispatchmessage, msg.hwnd='+inttohex(taddrint(lpmsg.hwnd),16));\r
-  if (lpmsg.lparam <> 0) and (lpmsg.message = WM_TIMER) then begin\r
-    timerproc := ttimerproc(lpmsg.lparam);\r
-    timerproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,gettickcount);\r
-    result := 0;\r
-  end else begin\r
-    structurelock.acquire;\r
-    try\r
-      window := findtree(@windows,inttostr(lpmsg.hwnd));\r
-      //we have to get the window procedure while the structurelock\r
-      //is still held as the window could be destroyed from another thread\r
-      //otherwise.\r
-      windowproc := window.windowproc;\r
-    finally\r
-      structurelock.release;\r
-    end;\r
-    if window <> nil then begin\r
-      result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);\r
-    end else begin\r
-      result := -1;\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure processtimers;\r
-begin\r
-end;\r
-\r
-function GetMessageinternal(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT; wremovemsg : UINT;peek:boolean): WINBOOL;\r
-var\r
-  tm : tthreadmanager;\r
-  threaddata : tthreaddata;\r
-  message : tmessageintransit;\r
-  nowtv : ttimeval;\r
-  timeouttv : ttimeval;\r
-  timeoutms : int64;\r
-\r
-begin\r
-  if hwnd <> 0 then raise exception.create('getting messages for an individual window is not supported');\r
-  if (wmsgfiltermin <> 0) or (wmsgfiltermax <> 0) then raise exception.create('message filtering is not supported');\r
-  structurelock.acquire;\r
-  result := true;\r
-  try\r
-    getthreadmanager(tm);\r
-    threaddata := findthreaddata(tm.GetCurrentThreadId);\r
-    if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');\r
-    message := threaddata.messagequeue;\r
-    gettimeofday(nowtv);\r
-    while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin\r
-      threaddata.waiting := true;\r
-      structurelock.release;\r
-      if (threaddata.nexttimer.tv_sec = TV_invalidtimebig.tv_sec) and (threaddata.nexttimer.tv_usec = TV_invalidtimebig.tv_usec) then begin\r
-        threaddata.messageevent.waitfor(INFINITE);\r
-      end else begin\r
-\r
-        timeouttv := threaddata.nexttimer;\r
-        timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);\r
-        //i'm assuming the timeout is in milliseconds\r
-        if (timeoutms > maxlongint) then timeoutms := maxlongint;\r
-        threaddata.messageevent.waitfor(timeoutms);\r
-\r
-      end;\r
-      structurelock.acquire;\r
-      threaddata.waiting := false;\r
-      message := threaddata.messagequeue;\r
-      gettimeofday(nowtv);\r
-    end;\r
-    if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin\r
-      processtimers;\r
-    end;\r
-    message := threaddata.messagequeue;\r
-    if message <> nil then begin\r
-      lpmsg := message.msg;\r
-      if wremovemsg=PM_REMOVE then begin\r
-        threaddata.messagequeue := message.next;\r
-        message.free;\r
-      end;\r
-    end else begin\r
-      result :=false;\r
-    end;\r
-    deletethreaddataifunused(threaddata);\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-end;\r
-\r
-function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;\r
-begin\r
-  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,false);\r
-end;\r
-\r
-function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;\r
-begin\r
-  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);\r
-end;\r
-\r
-function SetEvent(hEvent:THevent):WINBOOL;\r
-begin\r
-  hevent.setevent;\r
-  result := true;\r
-end;\r
-\r
-function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;\r
-begin\r
-  result := teventobject.create(lpeventattributes,bmanualreset,binitialstate,lpname);\r
-end;\r
-\r
-function terminatethread(threadhandle:tthreadid;dummy : integer) : boolean;\r
-var\r
-  tm : tthreadmanager;\r
-begin\r
-  getthreadmanager(tm);\r
-  tm.killthread(threadhandle);\r
-  result := true;\r
-end;\r
-\r
-function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;\r
-begin\r
-  result := event.waitfor(timeout);\r
-end;\r
-\r
-procedure removefrombuffer(n : integer; var buffer:string);\r
-begin\r
-  if n=length(buffer) then begin\r
-    buffer := '';\r
-  end else begin\r
-    uniquestring(buffer);\r
-    move(buffer[n+1],buffer[1],length(buffer)-n);\r
-    setlength(buffer,length(buffer)-n);\r
-  end;\r
-end;\r
-\r
-type\r
-  tsc=class\r
-    procedure available(sender:tobject;error:word);\r
-  end;\r
-\r
-var\r
-  recvbuf : string;\r
-\r
-procedure tsc.available(sender:tobject;error:word);\r
-var\r
-  message : tmessageintransit;\r
-  messagebytes : array[1..sizeof(tmessageintransit)] of char absolute  message;\r
-  i : integer;\r
-begin\r
-  //swriteln('received data on lcorelinkpipe');\r
-  recvbuf := recvbuf + lcorelinkpiperecv.receivestr;\r
-  while length(recvbuf) >= sizeof(tmessageintransit) do begin\r
-    for i := 1 to sizeof(tmessageintransit) do begin\r
-      messagebytes[i] := recvbuf[i];\r
-    end;\r
-    dispatchmessage(message.msg);\r
-    message.free;\r
-    removefrombuffer(sizeof(tmessageintransit),recvbuf);\r
-  end;\r
-end;\r
-\r
-procedure init;\r
-var\r
-  tm : tthreadmanager;\r
-  threaddata : tthreaddata;\r
-  pipeends : tfildes;\r
-  sc : tsc;\r
-begin\r
-  structurelock := tcriticalsection.create;\r
-  getthreadmanager(tm);\r
-  threaddata := findthreaddata(tm.GetCurrentThreadId);\r
-  threaddata.lcorethread := true;\r
-  fppipe(pipeends);\r
-  lcorelinkpipesend := pipeends[1];\r
-  lcorelinkpiperecv := tlasio.create(nil);\r
-  lcorelinkpiperecv.dup(pipeends[0]);\r
-  lcorelinkpiperecv.ondataavailable := sc.available;\r
-  recvbuf := '';\r
-end;\r
-\r
-var\r
-  lcorethreadtimers : thashtable;\r
-type\r
-  tltimerformsg = class(tltimer)\r
-  public\r
-    hwnd : hwnd;\r
-    id : taddrint;\r
-    procedure timer(sender : tobject);\r
-  end;\r
-\r
-procedure tltimerformsg.timer(sender : tobject);\r
-var\r
-  msg : tmsg;\r
-begin\r
-  ////swriteln('in tltimerformsg.timer');\r
-  fillchar(msg,sizeof(msg),0);\r
-  msg.message := WM_TIMER;\r
-  msg.hwnd := hwnd;\r
-  msg.wparam := ID;\r
-  msg.lparam := 0;\r
-  dispatchmessage(msg);\r
-end;\r
-\r
-function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;\r
-var\r
-  threaddata : tthreaddata;\r
-  ltimer : tltimerformsg;\r
-  tm : tthreadmanager;\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := findtree(@windows,inttostr(ahwnd));\r
-    if window= nil then raise exception.create('invalid window');\r
-    threaddata := findthreaddata(window.threadid);\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-  if threaddata.lcorethread then begin\r
-    getthreadmanager(tm);\r
-    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and removed from the lcore thread');\r
-    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');\r
-    if @lptimerfunc <> nil then raise exception.create('seperate timer functions are not supported');\r
-\r
-    //remove preexisting timer with same ID\r
-    killtimer(ahwnd,nIDEvent);\r
-\r
-    ltimer := tltimerformsg.create(nil);\r
-    ltimer.interval := uelapse;\r
-    ltimer.id := nidevent;\r
-    ltimer.hwnd := ahwnd;\r
-    ltimer.enabled := true;\r
-    ltimer.ontimer := ltimer.timer;\r
-\r
-    addtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(nIDEvent),ltimer);\r
-\r
-    result := nidevent;\r
-  end else begin\r
-    raise exception.create('settimer not implemented for threads other than the lcore thread');\r
-  end;\r
-end;\r
-\r
-function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;\r
-var\r
-  threaddata : tthreaddata;\r
-  ltimer : tltimerformsg;\r
-  tm : tthreadmanager;\r
-  window : twindow;\r
-begin\r
-  structurelock.acquire;\r
-  try\r
-    window := findtree(@windows,inttostr(ahwnd));\r
-    if window= nil then raise exception.create('invalid window');\r
-    threaddata := findthreaddata(window.threadid);\r
-  finally\r
-    structurelock.release;\r
-  end;\r
-  if threaddata.lcorethread then begin\r
-    getthreadmanager(tm);\r
-    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and remove from the lcore thread');\r
-    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');\r
-    ltimer := tltimerformsg(findtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent)));\r
-    if ltimer <> nil then begin\r
-      deltree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent));\r
-      ltimer.free;\r
-      result := true;\r
-    end else begin\r
-      result := false;\r
-    end;\r
-  end else begin\r
-    raise exception.create('settimer not implemented for threads other than the lcore thread');\r
-  end;\r
-end;\r
-\r
-end.
\ No newline at end of file

diff --git a/httpserver_20080306/lsignal.pas b/httpserver_20080306/lsignal.pas
deleted file mode 100755 (executable)
index 573fe28..0000000
--- a/httpserver_20080306/lsignal.pas
+++ /dev/null
@@ -1,198 +0,0 @@
-{lsocket.pas}\r
-\r
-{signal code by plugwash}\r
-\r
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-      \r
-unit lsignal;\r
-{$mode delphi}\r
-interface\r
-  uses sysutils,\r
-    {$ifdef VER1_0}\r
-      linux,\r
-    {$else}\r
-      baseunix,unix,\r
-    {$endif}\r
-    classes,lcore,lloopback;\r
-\r
-  type\r
-    tsignalevent=procedure(sender:tobject;signal:integer) of object;\r
-    tlsignal=class(tcomponent)\r
-    public\r
-      onsignal           : tsignalevent      ;\r
-      prevsignal         : tlsignal          ;\r
-      nextsignal         : tlsignal          ;\r
-\r
-      constructor create(aowner:tcomponent);override;\r
-      destructor destroy;override;\r
-    end;\r
-\r
-  \r
-  procedure starthandlesignal(signal:integer);\r
-\r
-var\r
-  firstsignal : tlsignal;\r
-  blockset : sigset;\r
-  signalloopback                        : tlloopback ;\r
-  
-implementation\r
-{$include unixstuff.inc}\r
-\r
-constructor tlsignal.create;\r
-begin\r
-  inherited create(AOwner);\r
-  nextsignal := firstsignal;\r
-  prevsignal := nil;\r
-\r
-  if assigned(nextsignal) then nextsignal.prevsignal := self;\r
-  firstsignal := self;\r
-\r
-  //interval := 1000;\r
-  //enabled := true;\r
-  //released := false;\r
-end;\r
-\r
-destructor tlsignal.destroy;\r
-begin\r
-  if prevsignal <> nil then begin\r
-    prevsignal.nextsignal := nextsignal;\r
-  end else begin\r
-    firstsignal := nextsignal;\r
-  end;\r
-  if nextsignal <> nil then begin\r
-    nextsignal.prevsignal := prevsignal;\r
-  end;\r
-  inherited destroy;\r
-end;\r
-{$ifdef linux}\r
-  {$ifdef ver1_9_8}\r
-    {$define needsignalworkaround}\r
-  {$endif}\r
-  {$ifdef ver2_0_0}\r
-    {$define needsignalworkaround}\r
-  {$endif}\r
-  {$ifdef ver2_0_2}\r
-    {$define needsignalworkaround}\r
-  {$endif}\r
-{$endif}\r
-{$ifdef needsignalworkaround}\r
-  //using the 1.9.6 version of this stuff because the 1.9.8 and 2.0.0 versions seem broken\r
-  type\r
-    TSysParam  = Longint;\r
-    TSysResult = longint;\r
-  const\r
-            syscall_nr_sigaction               = 67;\r
-  //function Do_SysCall(sysnr:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';\r
-  //function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';\r
-  //function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';\r
-  function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';\r
-  //function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';\r
-  //function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';\r
-\r
-  function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint;// [public, alias : 'FPC_SYSC_SIGACTION'];\r
-  {\r
-    Change action of process upon receipt of a signal.\r
-    Signum specifies the signal (all except SigKill and SigStop).\r
-    If Act is non-nil, it is used to specify the new action.\r
-    If OldAct is non-nil the previous action is saved there.\r
-  }\r
-  begin\r
-  //writeln('fucking');\r
-  {$ifdef RTSIGACTION}\r
-    {$ifdef cpusparc}\r
-      { Sparc has an extra stub parameter }\r
-      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));\r
-    {$else cpusparc}\r
-      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));\r
-    {$endif cpusparc}\r
-  {$else RTSIGACTION}\r
-    //writeln('nice');\r
-    Fpsigaction:=do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));\r
-  {$endif RTSIGACTION}\r
-  end;\r
-{$endif}\r
-\r
-// cdecl procedures are not name mangled\r
-// so USING something unlikely to cause colliesions in the global namespace\r
-// is a good idea\r
-procedure lsignal_handler( Sig : Integer);cdecl;\r
-var\r
-  currentsignal : tlsignal;\r
-begin\r
-//  writeln('in lsignal_hanler');\r
-  currentsignal := firstsignal;\r
-  while assigned(currentsignal) do begin\r
-    if assigned(currentsignal.onsignal) then currentsignal.onsignal(currentsignal,sig);\r
-    currentsignal := currentsignal.nextsignal;\r
-\r
-  end;\r
-//  writeln('about to send down signalloopback');\r
-  if assigned(signalloopback) then begin\r
-    signalloopback.sendstr(' ');\r
-  end;\r
-//  writeln('left lsignal_hanler');\r
-end;\r
-\r
-{$ifdef freebsd}\r
-\r
-{$if (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))}\r
-procedure lsignal_handler2(signal:longint;info:PSigInfo;context:psigcontext); cdecl;\r
-{$else}\r
-procedure lsignal_handler2(signal:longint;var info:TSigInfo_t;var context:SigContextRec); cdecl;\r
-{$endif}\r
-\r
-begin\r
-  lsignal_handler(signal);\r
-end;\r
-{$endif}\r
-\r
-\r
-const\r
-  allbitsset=-1;\r
-  {$ifdef ver1_0}\r
-    saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);\r
-  {$else}\r
-    {$ifdef darwin}\r
-      saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);\r
-    {$else}\r
-      {$ifdef freebsd}\r
-        //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH\r
-        {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}\r
-          saction : sigactionrec = (sa_handler:lsignal_handler2;sa_flags:0);\r
-        {$else}\r
-          saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);\r
-        {$endif}\r
-                                                         \r
-      {$else}\r
-        {$ifdef ver1_9_2}\r
-          saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);\r
-        {$else}\r
-         //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH\r
-         {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}\r
-           saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_6}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler);sa_flags:0;sa_restorer:nil);\r
-         {$else}\r
-            saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_6}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler));\r
-         {$endif}\r
-        {$endif}\r
-      {$endif}\r
-    {$endif}\r
-  {$endif}\r
-procedure starthandlesignal(signal:integer);\r
-begin\r
-  if signal in ([0..31]-[sigkill,sigstop]) then begin\r
-    sigprocmask(SIG_BLOCK,@blockset,nil);\r
-    sigaction(signal,@saction,nil)\r
-  end else begin\r
-    raise exception.create('invalid signal number')\r
-  end;\r
-end;\r
-\r
-initialization\r
-  fillchar(blockset,sizeof(blockset),0);\r
-  blockset[0] := $FFFFFFFF - (1 shl sigstop) - (1 shl sigkill) - (1 shl sigsegv);\r
-  saction.sa_mask := blockset;\r
-  \r
-end.\r

diff --git a/httpserver_20080306/lsocket.pas b/httpserver_20080306/lsocket.pas
deleted file mode 100755 (executable)
index 617f153..0000000
--- a/httpserver_20080306/lsocket.pas
+++ /dev/null
@@ -1,706 +0,0 @@
-{lsocket.pas}\r
-\r
-{socket code by plugwash}\r
-\r
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-{\r
-changes by plugwash (20030728)\r
-* created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it\r
-* changed tlasio to tlasio\r
-* split fdhandle into fdhandlein and fdhandleout\r
-* i now use fdsrmaster and fdswmaster instead of rebuilding the lists every loop\r
-* split lsocket.pas into lsocket.pas and lcore.pas\r
-\r
-\r
-changes by beware (20030903)\r
-* added getxaddr, getxport (local addr, port, as string)\r
-* added getpeername, remote addr+port as binary\r
-* added htons and htonl functions (endian swap, same interface as windows API)\r
-\r
-beware (20030905)\r
-* if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose)\r
-* (lcore) if closing the fd's in internalcose, set fd's to -1 because closing an fd makes it invalid\r
-\r
-beware (20030927)\r
-* fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check\r
-\r
-beware (20031017)\r
-* added getpeeraddr, getpeerport, remote addr+port as string\r
-}\r
-\r
-\r
-unit lsocket;\r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
-interface\r
-  uses\r
-    sysutils,\r
-    {$ifdef win32}\r
-      windows,winsock,\r
-    {$else}\r
-\r
-      {$ifdef VER1_0}\r
-        linux,\r
-      {$else}\r
-        baseunix,unix,\r
-      {$endif}\r
-      sockets,\r
-    {$endif}\r
-    classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync;\r
-type\r
-  sunB = packed record\r
-    s_b1, s_b2, s_b3, s_b4: byte;\r
-  end;\r
-\r
-  SunW = packed record\r
-    s_w1, s_w2: word;\r
-  end;\r
-\r
-  TInAddr = packed record\r
-    case integer of\r
-      0: (S_un_b: SunB);\r
-      1: (S_un_w: SunW);\r
-      2: (S_addr: cardinal);\r
-  end;\r
-  {$ifdef ipv6}\r
-    {$ifdef ver1_0}\r
-      cuint16=word;\r
-      cuint32=dword;\r
-      sa_family_t=word;\r
-\r
-\r
-      TInetSockAddr6 = packed Record\r
-        sin6_family   : sa_family_t;\r
-        sin6_port     : cuint16;\r
-        sin6_flowinfo : cuint32;\r
-        sin6_addr     : Tin6_addr;\r
-        sin6_scope_id : cuint32;\r
-      end;\r
-    {$endif}\r
-  {$endif}\r
-  TinetSockAddrv = packed record\r
-    case integer of\r
-      0: (InAddr:TInetSockAddr);\r
-      {$ifdef ipv6}\r
-      1: (InAddr6:TInetSockAddr6);\r
-      {$endif}\r
-  end;\r
-  Pinetsockaddrv = ^Tinetsockaddrv;\r
-\r
-\r
-  type\r
-    tsockaddrin=TInetSockAddr;\r
-\r
-  type\r
-    TLsocket = class(tlasio)\r
-    public\r
-      //a: string;\r
-\r
-      inAddr             : TInetSockAddrV;\r
-{      inAddrSize:integer;}\r
-\r
-      //host               : THostentry      ;\r
-\r
-      //mainthread         : boolean         ; //for debuggin only\r
-      addr:string;\r
-      port:string;\r
-      localaddr:string;\r
-      localport:string;\r
-      proto:string;\r
-      udp:boolean;\r
-      listenqueue:integer;\r
-      function getaddrsize:integer;\r
-      procedure connect; virtual;\r
-      procedure bindsocket;\r
-      procedure listen;\r
-      function accept : longint;\r
-      function sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer; virtual;\r
-      function receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer; virtual;\r
-      //procedure internalclose(error:word);override;\r
-      procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;\r
-      function send(data:pointer;len:integer):integer;override;\r
-      procedure sendstr(const str : string);override;\r
-      function Receive(Buf:Pointer;BufSize:integer):integer; override;\r
-      function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;\r
-      procedure getXaddrbin(var binip:tbinip); virtual;\r
-      procedure getpeeraddrbin(var binip:tbinip); virtual;\r
-      function getXaddr:string; virtual;\r
-      function getpeeraddr:string; virtual;\r
-      function getXport:string; virtual;\r
-      function getpeerport:string; virtual;\r
-      constructor Create(AOwner: TComponent); override;\r
-      {$ifdef win32}\r
-        procedure myfdclose(fd : integer); override;\r
-        function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;\r
-        function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override;\r
-      {$endif}\r
-    end;\r
-    tsocket=longint; // for compatibility with twsocket\r
-\r
-  twsocket=tlsocket; {easy}\r
-\r
-function htons(w:word):word;\r
-function htonl(i:integer):integer;\r
-{!!!function longipdns(s:string):longint;}\r
-\r
-{$ifdef ipv6}\r
-const\r
-  v4listendefault:boolean=false;\r
-{$endif}\r
-\r
-\r
-const\r
-  TCP_NODELAY=1;\r
-  IPPROTO_TCP=6;\r
-\r
-implementation\r
-{$include unixstuff.inc}\r
-\r
-function longip(s:string):longint;{$ifdef fpc}inline;{$endif}\r
-var\r
-  l:longint;\r
-  a,b:integer;\r
-\r
-function convertbyte(const s:string):integer;{$ifdef fpc}inline;{$endif}\r
-begin\r
-  result := strtointdef(s,-1);\r
-  if result < 0 then exit;\r
-  if result > 255 then exit;\r
-\r
-  {01 exception}\r
-  if (result <> 0) and (s[1] = '0') then begin\r
-    result := -1;\r
-    exit;\r
-  end;\r
-\r
-  {+1 exception}\r
-  if not (s[1] in ['0'..'9']) then begin\r
-    result := -1;\r
-    exit\r
-  end;\r
-end;\r
-\r
-begin\r
-  result := 0;\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := b shl 24;\r
-  s := copy(s,a+1,256);\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := l or b shl 16;\r
-  s := copy(s,a+1,256);\r
-  a := pos('.',s);\r
-  if a = 0 then exit;\r
-  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
-  l := l or b shl 8;\r
-  s := copy(s,a+1,256);\r
-  b := convertbyte(copy(s,1,256));if (b < 0) then exit;\r
-  l := l or b;\r
-  result := l;\r
-end;\r
-\r
-(*!!!\r
-function longipdns(s:string):longint;\r
-var\r
-  host : thostentry;\r
-begin\r
-  if s = '0.0.0.0' then begin\r
-    result := 0;\r
-  end else begin\r
-    result := longip(s);\r
-    if result = 0 then begin\r
-      if gethostbyname(s,host) then begin;\r
-        result := htonl(Longint(Host.Addr));\r
-      end;\r
-      //writeln(inttohex(longint(host.addr),8))\r
-    end;\r
-    if result = 0 then begin\r
-      if resolvehostbyname(s,host) then begin;\r
-        result := htonl(Longint(Host.Addr));\r
-      end;\r
-      //writeln(inttohex(longint(host.addr),8))\r
-    end;\r
-  end;\r
-end;\r
-*)\r
-\r
-\r
-function htons(w:word):word;\r
-begin\r
-  {$ifndef ENDIAN_BIG}\r
-  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);\r
-  {$else}\r
-  result := w;\r
-  {$endif}\r
-end;\r
-\r
-function htonl(i:integer):integer;\r
-begin\r
-  {$ifndef ENDIAN_BIG}\r
-  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);\r
-  {$else}\r
-  result := i;\r
-  {$endif}\r
-end;\r
-\r
-function tlsocket.getaddrsize:integer;\r
-begin\r
-  {$ifdef ipv6}\r
-  if inaddr.inaddr.family = AF_INET6 then result := sizeof(tinetsockaddr6) else\r
-  {$endif}\r
-  result := sizeof(tinetsockaddr);\r
-end;\r
-\r
-function makeinaddrv(addr,port:string;var inaddr:tinetsockaddrv):integer;\r
-var\r
-  biniptemp:tbinip;\r
-begin\r
-  result := 0;\r
-  biniptemp := forwardlookup(addr,10);\r
-  fillchar(inaddr,sizeof(inaddr),0);\r
-  //writeln('converted address '+addr+' to binip '+ipbintostr(biniptemp));\r
-  if biniptemp.family = AF_INET then begin\r
-    inAddr.InAddr.family:=AF_INET;\r
-    inAddr.InAddr.port:=htons(strtointdef(port,0));\r
-    inAddr.InAddr.addr:=biniptemp.ip;\r
-    result := sizeof(tinetsockaddr);\r
-  end else\r
-  {$ifdef ipv6}\r
-  if biniptemp.family = AF_INET6 then begin\r
-    inAddr.InAddr6.sin6_family:=AF_INET6;\r
-    inAddr.InAddr6.sin6_port:=htons(strtointdef(port,0));\r
-    inAddr.InAddr6.sin6_addr:=biniptemp.ip6;\r
-    result := sizeof(tinetsockaddr6);\r
-  end else\r
-  {$endif}\r
-  raise esocketexception.create('unable to resolve address: '+addr);\r
-end;\r
-\r
-procedure tlsocket.connect;\r
-var\r
-  a:integer;\r
-begin\r
-  if state <> wsclosed then close;\r
-  //prevtime := 0;\r
-  makeinaddrv(addr,port,inaddr);\r
-\r
-  udp := uppercase(proto) = 'UDP';\r
-  if udp then a := SOCK_DGRAM else a := SOCK_STREAM;\r
-  a := Socket(inaddr.inaddr.family,a,0);\r
-\r
-  //writeln(ord(inaddr.inaddr.family));\r
-  if a = -1 then begin\r
-    lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};\r
-    raise esocketexception.create('unable to create socket');\r
-  end;\r
-  try\r
-    dup(a);\r
-    bindsocket;\r
-    if udp then begin\r
-      {$ifndef win32}\r
-        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));\r
-      {$endif}\r
-      state := wsconnected;\r
-      if assigned(onsessionconnected) then onsessionconnected(self,0);\r
-    end else begin\r
-      state :=wsconnecting;\r
-      {$ifdef win32}\r
-        //writeln(inaddr.inaddr.port);\r
-        winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);\r
-      {$else}\r
-        sockets.Connect(fdhandlein,inADDR,getaddrsize);\r
-      {$endif}\r
-    end;\r
-    eventcore.rmasterset(fdhandlein,false);\r
-    if udp then begin\r
-      eventcore.wmasterclr(fdhandleout);\r
-    end else begin\r
-      eventcore.wmasterset(fdhandleout);\r
-    end;\r
-    //sendq := '';\r
-  except\r
-    on e: exception do begin\r
-      fdcleanup;\r
-      raise; //reraise the exception\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure tlsocket.sendstr(const str : string);\r
-begin\r
-  if udp then begin\r
-    send(@str[1],length(str))\r
-  end else begin\r
-    inherited sendstr(str);\r
-  end;\r
-end;\r
-\r
-function tlsocket.send(data:pointer;len:integer):integer;\r
-begin\r
-  if udp then begin\r
-    //writeln('sending to '+inttohex(inaddr.inaddr.addr,8));\r
-    result := sendto(inaddr.inaddr,getaddrsize,data,len)\r
-;\r
-    //writeln('send result',result);\r
-    //writeln('errno',errno);\r
-  end else begin\r
-    result := inherited send(data,len);\r
-  end;\r
-end;\r
-\r
-\r
-function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;\r
-begin\r
-  if udp then begin\r
-    result := myfdread(self.fdhandlein,buf^,bufsize);\r
-  end else begin\r
-    result := inherited receive(buf,bufsize);\r
-  end;\r
-end;\r
-\r
-procedure tlsocket.bindsocket;\r
-var\r
-  a:integer;\r
-  inAddrtemp:TInetSockAddrV;\r
-  inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;\r
-  inaddrtempsize:integer;\r
-begin\r
-  try\r
-    if (localaddr <> '') or (localport <> '') then begin\r
-      if localaddr = '' then begin\r
-        {$ifdef ipv6}\r
-        if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else\r
-        {$endif}\r
-        localaddr := '0.0.0.0';\r
-      end;\r
-      //gethostbyname(localaddr,host);\r
-\r
-      inaddrtempsize := makeinaddrv(localaddr,localport,inaddrtemp);\r
-\r
-      If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin\r
-        state := wsclosed;\r
-        lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};\r
-        raise ESocketException.create('unable to bind, error '+inttostr(lasterror));\r
-      end;\r
-      state := wsbound;\r
-    end;\r
-  except\r
-    on e: exception do begin\r
-      fdcleanup;\r
-      raise; //reraise the exception\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure tlsocket.listen;\r
-var\r
-  yes:longint;\r
-  socktype:integer;\r
-  biniptemp:tbinip;\r
-  origaddr:string;\r
-begin\r
-  if state <> wsclosed then close;\r
-  udp := uppercase(proto) = 'UDP';\r
-  if udp then socktype := SOCK_DGRAM else socktype := SOCK_STREAM;\r
-  origaddr := addr;\r
-\r
-  if addr = '' then begin\r
-    {$ifdef ipv6}\r
-    if not v4listendefault then begin\r
-      addr := '::';\r
-    end else\r
-    {$endif}\r
-    addr := '0.0.0.0';\r
-  end;\r
-  biniptemp := forwardlookup(addr,10);\r
-  addr := ipbintostr(biniptemp);\r
-  fdhandlein := socket(biniptemp.family,socktype,0);\r
-  {$ifdef ipv6}\r
-  if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin\r
-    addr := '0.0.0.0';\r
-    fdhandlein := socket(AF_INET,socktype,0);\r
-  end;\r
-  {$endif}\r
-  if fdhandlein = -1 then raise ESocketException.create('unable to create socket');\r
-  dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things\r
-  //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup\r
-  state := wsclosed; // then set this back as it was an undesired side effect of dup\r
-\r
-  try\r
-    yes := $01010101;  {Copied this from existing code. Value is empiric,\r
-                    but works. (yes=true<>0) }\r
-    {$ifndef win32}\r
-      if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin\r
-        raise ESocketException.create('unable to set socket options');\r
-      end;\r
-    {$endif}\r
-    localaddr := addr;\r
-    localport := port;\r
-    bindsocket;\r
-\r
-    if not udp then begin\r
-      {!!! allow custom queue length? default 5}\r
-      if listenqueue = 0 then listenqueue := 5;\r
-      If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise esocketexception.create('unable to listen');\r
-      state := wsListening;\r
-    end else begin\r
-      {$ifndef win32}\r
-        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));\r
-      {$endif}\r
-      state := wsconnected;\r
-    end;\r
-  finally\r
-    if state = wsclosed then begin\r
-      if fdhandlein >= 0 then begin\r
-        {one *can* get here without fd -beware}\r
-        eventcore.rmasterclr(fdhandlein);\r
-        myfdclose(fdhandlein); // we musnt leak file discriptors\r
-        eventcore.setfdreverse(fdhandlein,nil);\r
-        fdhandlein := -1;\r
-      end;\r
-    end else begin\r
-      eventcore.rmasterset(fdhandlein,true);\r
-    end;\r
-    if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);\r
-  end;\r
-  //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); \r
-end;\r
-\r
-function tlsocket.accept : longint;\r
-var\r
-  FromAddrSize     : LongInt;        // i don't realy know what to do with these at this\r
-  FromAddr         : TInetSockAddrV;  // at this point time will tell :)\r
-begin\r
-\r
-  FromAddrSize := Sizeof(FromAddr);\r
-  {$ifdef win32}\r
-    result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);\r
-  {$else}\r
-    result := sockets.accept(fdhandlein,fromaddr,fromaddrsize);\r
-  {$endif}\r
-  //now we have accepted one request start monitoring for more again\r
-  eventcore.rmasterset(fdhandlein,true);\r
-\r
-  if result = -1 then raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting');\r
-  if result > absoloutemaxs then begin\r
-    myfdclose(result);\r
-    result := -1;\r
-    raise esocketexception.create('file discriptor out of range');\r
-  end;\r
-end;\r
-\r
-function tlsocket.sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer;\r
-var\r
-  destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute dest;\r
-begin\r
-  result := {$ifdef win32}winsock{$else}sockets{$endif}.sendto(self.fdhandleout,data^,len,0,destx,destlen);\r
-end;\r
-\r
-function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer;\r
-var\r
-  srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute src;\r
-begin\r
-  result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen);\r
-end;\r
-\r
-procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);\r
-var\r
-  tempbuf:array[0..receivebufsize-1] of byte;\r
-begin\r
-  //writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger);\r
-  if (state =wslistening) and readtrigger then begin\r
-{    debugout('listening socket triggered on read');}\r
-    eventcore.rmasterclr(fdhandlein);\r
-    if assigned(onsessionAvailable) then onsessionAvailable(self,0);\r
-  end;\r
-  if udp and readtrigger then begin\r
-    if assigned(ondataAvailable) then ondataAvailable(self,0);\r
-    {!!!test}\r
-    exit;\r
-  end;\r
-  if (state =wsconnecting) and writetrigger then begin\r
-    // code for dealing with the reults of a non-blocking connect is\r
-    // rather complex\r
-    // if just write is triggered it means connect suceeded\r
-    // if both read and write are triggered it can mean 2 things\r
-    // 1: connect ok and data availible\r
-    // 2: connect fail\r
-    // to find out which you must read from the socket and look for errors\r
-    // there if we read successfully we drop through into the code for fireing\r
-    // the read event\r
-    if not readtrigger then begin\r
-      state := wsconnected;\r
-      if assigned(onsessionconnected) then onsessionconnected(self,0);\r
-    end else begin\r
-      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));\r
-      if numread <> -1 then begin\r
-        state := wsconnected;\r
-        if assigned(onsessionconnected) then onsessionconnected(self,0);\r
-        //connectread := true;\r
-        recvq.add(@tempbuf,numread);\r
-      end else begin\r
-        state := wsconnected;\r
-        if assigned(onsessionconnected) then onsessionconnected(self,{$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});\r
-{        debugout('connect fail');}\r
-        self.internalclose(0);\r
-        recvq.del(maxlongint);\r
-      end;\r
-      // if things went well here we are now in the state wsconnected with data sitting in our receive buffer\r
-      // so we drop down into the processing for data availible\r
-    end;\r
-    if fdhandlein >= 0 then begin\r
-      if state = wsconnected then begin\r
-        eventcore.rmasterset(fdhandlein,false);\r
-      end else begin\r
-        eventcore.rmasterclr(fdhandlein);\r
-      end;\r
-    end;\r
-    if fdhandleout >= 0 then begin\r
-      if sendq.size = 0 then begin\r
-        //don't clear the bit in fdswmaster if data is in the sendq\r
-        eventcore.wmasterclr(fdhandleout);\r
-      end;\r
-    end;\r
-\r
-  end;\r
-  inherited handlefdtrigger(readtrigger,writetrigger);\r
-end;\r
-\r
-constructor tlsocket.Create(AOwner: TComponent);\r
-begin\r
-  inherited create(aowner);\r
-  closehandles := true;\r
-end;\r
-\r
-\r
-function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;\r
-var\r
-  addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;\r
-begin\r
-  result := {$ifdef win32}winsock{$else}sockets{$endif}.getpeername(self.fdhandlein,addrx,addrlen);\r
-end;\r
-\r
-procedure tlsocket.getxaddrbin(var binip:tbinip);\r
-var\r
-  addr:tinetsockaddrv;\r
-  i:integer;\r
-begin\r
-  i := sizeof(addr);\r
-  fillchar(addr,sizeof(addr),0);\r
-\r
-  {$ifdef win32}\r
-    winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);\r
-  {$else}\r
-    sockets.getsocketname(self.fdhandlein,addr,i);\r
-  {$endif}\r
-  binip.family := addr.inaddr.family;\r
-  {$ifdef ipv6}\r
-  if addr.inaddr6.sin6_family = AF_INET6 then begin\r
-    binip.ip6 := addr.inaddr6.sin6_addr;\r
-  end else\r
-  {$endif}\r
-  begin\r
-    binip.ip := addr.inaddr.addr;\r
-  end;\r
-  converttov4(binip);\r
-end;\r
-\r
-procedure tlsocket.getpeeraddrbin(var binip:tbinip);\r
-var\r
-  addr:tinetsockaddrv;\r
-  i:integer;\r
-begin\r
-  i := sizeof(addr);\r
-  fillchar(addr,sizeof(addr),0);\r
-  {$ifdef win32}\r
-    winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);\r
-  {$else}\r
-    sockets.getpeername(self.fdhandlein,addr,i);\r
-  {$endif}\r
-\r
-  binip.family := addr.inaddr.family;\r
-  {$ifdef ipv6}\r
-  if addr.inaddr6.sin6_family = AF_INET6 then begin\r
-    binip.ip6 := addr.inaddr6.sin6_addr;\r
-  end else\r
-  {$endif}\r
-  begin\r
-    binip.ip := addr.inaddr.addr;\r
-  end;\r
-  converttov4(binip);\r
-end;\r
-\r
-function tlsocket.getXaddr:string;\r
-var\r
-  biniptemp:tbinip;\r
-begin\r
-  getxaddrbin(biniptemp);\r
-  result := ipbintostr(biniptemp);\r
-  if result = '' then result := 'error';\r
-end;\r
-\r
-function tlsocket.getpeeraddr:string;\r
-var\r
-  biniptemp:tbinip;\r
-begin\r
-  getpeeraddrbin(biniptemp);\r
-  result := ipbintostr(biniptemp);\r
-  if result = '' then result := 'error';\r
-end;\r
-\r
-function tlsocket.getXport:string;\r
-var\r
-  addr:{$ifdef win32}winsock.tsockaddr{$else}tinetsockaddr{$endif};\r
-  i:integer;\r
-begin\r
-  i := sizeof(addr);\r
-  {$ifdef win32}\r
-    winsock.getsockname(self.fdhandlein,addr,i);\r
-    i := htons(addr.sin_port);\r
-  {$else}\r
-    sockets.getsocketname(self.fdhandlein,addr,i);\r
-    i := htons(addr.port);\r
-  {$endif}\r
-  result := inttostr(i);\r
-end;\r
-\r
-function tlsocket.getpeerport:string;\r
-var\r
-  addr:{$ifdef win32}winsock.tsockaddr{$else}tinetsockaddr{$endif};\r
-  i:integer;\r
-begin\r
-  i := sizeof(addr);\r
-  {$ifdef win32}\r
-    winsock.getpeername(self.fdhandlein,addr,i);\r
-    i := htons(addr.sin_port);\r
-  {$else}\r
-    sockets.getpeername(self.fdhandlein,addr,i);\r
-    i := htons(addr.port);\r
-  {$endif}\r
-  result := inttostr(i);\r
-end;\r
-\r
-{$ifdef win32}\r
-  procedure tlsocket.myfdclose(fd : integer);\r
-  begin\r
-    closesocket(fd);\r
-  end;\r
-  function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;\r
-  begin\r
-    result := winsock.send(fd,(@buf)^,size,0);\r
-  end;\r
-  function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;\r
-  begin\r
-    result := winsock.recv(fd,buf,size,0);\r
-  end;\r
-{$endif}\r
-
-end.\r
-\r

diff --git a/httpserver_20080306/ltimevalstuff.inc b/httpserver_20080306/ltimevalstuff.inc
deleted file mode 100755 (executable)
index 0ac92cb..0000000
--- a/httpserver_20080306/ltimevalstuff.inc
+++ /dev/null
@@ -1,42 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-\r
-\r
-{add nn msec to tv}\r
-const\r
-  tv_invalidtimebig : ttimeval = (tv_sec:maxlongint;tv_usec:maxlongint);\r
-  //tv_invalidtimebig will always compare as greater than any valid timeval\r
-procedure tv_add(var tv:ttimeval;msec:integer);//{ $ifdef fpc}inline;{ $endif}\r
-begin\r
-  inc(tv.tv_usec,msec*1000);\r
-  inc(tv.tv_sec,tv.tv_usec div 1000000);\r
-  tv.tv_usec := tv.tv_usec mod 1000000;\r
-end;\r
-\r
-{tv1 >= tv2}\r
-function tv_compare(const tv1,tv2:ttimeval):boolean;//{ $ifdef fpc}inline;{ $endif}\r
-begin\r
-  if tv1.tv_sec = tv2.tv_sec then begin\r
-    result := tv1.tv_usec >= tv2.tv_usec;\r
-  end else result := tv1.tv_sec > tv2.tv_sec;\r
-end;\r
-\r
-procedure tv_substract(var tv:ttimeval;const tv2:ttimeval);//{ $ifdef fpc}inline;{ $endif}\r
-begin\r
-  dec(tv.tv_usec,tv2.tv_usec);\r
-  if tv.tv_usec < 0 then begin\r
-    inc(tv.tv_usec,1000000);\r
-    dec(tv.tv_sec)\r
-  end;\r
-  dec(tv.tv_sec,tv2.tv_sec);\r
-end;\r
-\r
-procedure msectotimeval(var tv:ttimeval;msec:integer);\r
-begin\r
-  tv.tv_sec := msec div 1000;\r
-  tv.tv_usec := (msec mod 1000)*1000;\r
-end;\r
-\r

diff --git a/httpserver_20080306/pgtypes.pas b/httpserver_20080306/pgtypes.pas
deleted file mode 100755 (executable)
index 3c48e26..0000000
--- a/httpserver_20080306/pgtypes.pas
+++ /dev/null
@@ -1,20 +0,0 @@
-{io core originally for linux bworld}\r
-\r
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-unit pgtypes;\r
-interface\r
-  type\r
-    {$ifdef cpu386}{$define i386}{$endif}\r
-    {$ifdef i386}\r
-      taddrint=longint;\r
-    {$else}\r
-      taddrint=sizeint;\r
-    {$endif}\r
-    paddrint=^taddrint;\r
-\r
-implementation\r
-end.\r

diff --git a/httpserver_20080306/uint32.inc b/httpserver_20080306/uint32.inc
deleted file mode 100755 (executable)
index 897db79..0000000
--- a/httpserver_20080306/uint32.inc
+++ /dev/null
@@ -1,14 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green
-  For conditions of distribution and use, see copyright notice in zlib_license.txt
-  which is included in the package
-  ----------------------------------------------------------------------------- }\r
-type\r
-  {delphi 3 and before do not have a 32 bits unsigned integer type,\r
-  but longint has the correct behavior - it doesn't on newer delphi versions}\r
-  {$ifndef fpc}\r
-    {$ifdef ver70}{$define pred4}{$endif} {tp7}\r
-    {$ifdef ver80}{$define pred4}{$endif} {delphi 1}\r
-    {$ifdef ver90}{$define pred4}{$endif} {delphi 2}\r
-    {$ifdef ver100}{$define pred4}{$endif} {delphi 3}\r
-  {$endif}\r
-  uint32={$ifdef pred4}longint{$else}longword{$endif};\r

diff --git a/httpserver_20080306/unixstuff.inc b/httpserver_20080306/unixstuff.inc
deleted file mode 100755 (executable)
index 92ed308..0000000
--- a/httpserver_20080306/unixstuff.inc
+++ /dev/null
@@ -1,66 +0,0 @@
-{$ifdef UNIX}\r
-  {$macro on}\r
-  {$ifdef VER1_0}\r
-    {$define tv_sec := sec}\r
-    {$define tv_usec := usec}\r
-    function dup(const original:integer):integer;inline;\r
-    begin\r
-      linux.dup(original,result);\r
-    end;\r
-    {$define gettimeofdaysec := gettimeofday}\r
-  {$else}\r
-    \r
-    {$define sigprocmask := fpsigprocmask}\r
-    {$define sigaction   := fpsigaction}\r
-    {$define fdclose     := fpclose}\r
-    {$define fcntl       := fpfcntl}\r
-    {$define fdwrite     := fpwrite}\r
-    {$define fdread      := fpread}\r
-    {$define fdopen      := fpopen}\r
-    {$define select      := fpselect}\r
-    {$define linuxerror  := fpgeterrno}\r
-    {$define fork        := fpfork}\r
-    {$define getpid      := fpgetpid}\r
-    {$define getenv      := fpgetenv}\r
-    {$define chmod       := fpchmod}\r
-    {$define dup2        := fpdup2}\r
-    {$ifndef ver1_9_2}\r
-      {$define flock       := fpflock}\r
-    {$endif}\r
-    procedure gettimeofday(var tv:ttimeval);inline;\r
-    begin\r
-      fpgettimeofday(@tv,nil);    \r
-    end;\r
-    function gettimeofdaysec : longint;\r
-    var\r
-      tv:ttimeval;\r
-    begin\r
-      gettimeofday(tv);\r
-      result := tv.tv_sec;\r
-    end;\r
-\r
-    //a function is used here rather than a define to prevent issues with tlasio.dup\r
-    function dup(const original:integer):integer;inline;\r
-    begin\r
-      result := fpdup(original);\r
-    end;\r
-    function octal(invalue:longint):longint;\r
-    var\r
-      a : integer;\r
-      i : integer;\r
-    begin\r
-      i := 0;\r
-      result := 0;\r
-      while invalue <> 0 do begin\r
-        a := invalue mod 10;\r
-        result := result + (a shl (i*3));\r
-\r
-        invalue := invalue div 10;\r
-        inc(i);\r
-      end;\r
-    end;\r
-    const\r
-      sys_eintr=esyseintr;\r
-\r
-  {$endif}\r
-{$endif}\r

diff --git a/httpserver_20080306/wcore.pas b/httpserver_20080306/wcore.pas
deleted file mode 100755 (executable)
index 40505ef..0000000
--- a/httpserver_20080306/wcore.pas
+++ /dev/null
@@ -1,372 +0,0 @@
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
-  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
-  which is included in the package\r
-  ----------------------------------------------------------------------------- }\r
-\r
-unit wcore;\r
-\r
-{\r
-lcore compatible interface for windows\r
-\r
-- messageloop\r
-\r
-- tltimer\r
-\r
-}\r
-//note: events after release are normal and are the apps responsibility to deal with safely\r
-interface\r
-\r
-  uses\r
-    classes,windows,mmsystem;\r
-\r
-  type\r
-    float=double;\r
-\r
-    tlcomponent = class(tcomponent)\r
-    public\r
-      released:boolean;\r
-      procedure release;\r
-      destructor destroy; override;\r
-    end;\r
-\r
-    tltimer=class(tlcomponent)\r
-    public\r
-      ontimer:tnotifyevent;\r
-      initialevent:boolean;\r
-      initialdone:boolean;\r
-      prevtimer:tltimer;\r
-      nexttimer:tltimer;\r
-      interval:integer;        {miliseconds, default 1000}\r
-      enabled:boolean;\r
-      nextts:integer;\r
-      constructor create(aowner:tcomponent);override;\r
-      destructor destroy;override;\r
-    end;\r
-\r
-    ttaskevent=procedure(wparam,lparam:longint) of object;\r
-\r
-    tltask=class(tobject)\r
-    public\r
-      handler  : ttaskevent;\r
-      obj      : tobject;\r
-      wparam   : longint;\r
-      lparam   : longint;\r
-      nexttask : tltask;\r
-      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-    end;\r
-\r
-procedure messageloop;\r
-procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-procedure disconnecttasks(aobj:tobject);\r
-procedure exitmessageloop;\r
-procedure processmessages;\r
-\r
-var\r
-  onshutdown:procedure(s:string);\r
-\r
-implementation\r
-\r
-uses\r
-  {$ifdef fpc}\r
-  bmessages;\r
-  {$else}\r
-  messages;\r
-  {$endif}\r
-\r
-\r
-const\r
-  WINMSG_TASK=WM_USER;\r
-\r
-var\r
-  hwndwcore:hwnd;\r
-  firsttimer:tltimer;\r
-  timesubstract:integer;\r
-  firsttask,lasttask,currenttask:tltask;\r
-\r
-procedure tlcomponent.release;\r
-begin\r
-  released := true;\r
-end;\r
-\r
-destructor tlcomponent.destroy;\r
-begin\r
-  disconnecttasks(self);\r
-  inherited destroy;\r
-end;\r
-\r
-{------------------------------------------------------------------------------}\r
-\r
-constructor tltimer.create;\r
-begin\r
-  inherited create(AOwner);\r
-  nexttimer := firsttimer;\r
-  prevtimer := nil;\r
-\r
-  if assigned(nexttimer) then nexttimer.prevtimer := self;\r
-  firsttimer := self;\r
-\r
-  interval := 1000;\r
-  enabled := true;\r
-  released := false;\r
-end;\r
-\r
-destructor tltimer.destroy;\r
-begin\r
-  if prevtimer <> nil then begin\r
-    prevtimer.nexttimer := nexttimer;\r
-  end else begin\r
-    firsttimer := nexttimer;\r
-  end;\r
-  if nexttimer <> nil then begin\r
-    nexttimer.prevtimer := prevtimer;\r
-  end;\r
-  inherited destroy;\r
-end;\r
-\r
-{------------------------------------------------------------------------------}\r
-\r
-function wcore_timehandler:integer;\r
-const\r
-  rollover_bits=30;\r
-var\r
-  tv,tvnow:integer;\r
-  currenttimer,temptimer:tltimer;\r
-begin\r
-  if not assigned(firsttimer) then begin\r
-    result := 1000;\r
-    exit;\r
-  end;\r
-\r
-  tvnow := timegettime;\r
-  if (tvnow and ((-1) shl rollover_bits)) <> timesubstract then begin\r
-    currenttimer := firsttimer;\r
-    while assigned(currenttimer) do begin\r
-      dec(currenttimer.nextts,(1 shl rollover_bits));\r
-      currenttimer := currenttimer.nexttimer;\r
-    end;\r
-    timesubstract := tvnow and ((-1) shl rollover_bits);\r
-  end;\r
-  tvnow := tvnow and ((1 shl rollover_bits)-1);\r
-\r
-  currenttimer := firsttimer;\r
-  while assigned(currenttimer) do begin\r
-    if tvnow >= currenttimer.nextts then begin\r
-      if assigned(currenttimer.ontimer) then begin\r
-        if currenttimer.enabled then begin\r
-          if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);\r
-          currenttimer.initialdone := true;\r
-        end;\r
-      end;\r
-      currenttimer.nextts := tvnow+currenttimer.interval;\r
-    end;\r
-    temptimer := currenttimer;\r
-    currenttimer := currenttimer.nexttimer;\r
-    if temptimer.released then temptimer.free;\r
-  end;\r
-\r
-  tv := maxlongint;\r
-  currenttimer := firsttimer;\r
-  while assigned(currenttimer) do begin\r
-    if currenttimer.nextts < tv then tv := currenttimer.nextts;\r
-    currenttimer := currenttimer.nexttimer;\r
-  end;\r
-  result := tv-tvnow;\r
-  if result < 15 then result := 15;\r
-end;\r
-\r
-{------------------------------------------------------------------------------}\r
-\r
-constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  inherited create;\r
-  handler   := ahandler;\r
-  obj       := aobj;\r
-  wparam    := awparam;\r
-  lparam    := alparam;\r
-  {nexttask  := firsttask;\r
-  firsttask := self;}\r
-  if assigned(lasttask) then begin\r
-    lasttask.nexttask := self;\r
-  end else begin\r
-    firsttask := self;\r
-    postmessage(hwndwcore,WINMSG_TASK,0,0);\r
-  end;\r
-  lasttask := self;\r
-  //ahandler(wparam,lparam);\r
-end;\r
-\r
-procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);\r
-begin\r
-  tltask.create(ahandler,aobj,awparam,alparam);\r
-end;\r
-\r
-procedure disconnecttasks(aobj:tobject);\r
-var\r
-  currenttasklocal : tltask ;\r
-  counter          : byte   ;\r
-begin\r
-  for counter := 0 to 1 do begin\r
-    if counter = 0 then begin\r
-      currenttasklocal := firsttask; //main list of tasks\r
-    end else begin\r
-      currenttasklocal := currenttask; //needed in case called from a task\r
-    end;\r
-    // note i don't bother to sestroy the links here as that will happen when\r
-    // the list of tasks is processed anyway\r
-    while assigned(currenttasklocal) do begin\r
-      if currenttasklocal.obj = aobj then begin\r
-        currenttasklocal.obj := nil;\r
-        currenttasklocal.handler := nil;\r
-      end;\r
-      currenttasklocal := currenttasklocal.nexttask;\r
-    end;\r
-  end;\r
-end;\r
-\r
-procedure dotasks;\r
-var\r
-  temptask:tltask;\r
-begin\r
-  if firsttask = nil then exit;\r
-\r
-  currenttask := firsttask;\r
-  firsttask := nil;\r
-  lasttask  := nil;\r
-  while assigned(currenttask) do begin\r
-    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);\r
-    temptask := currenttask;\r
-    currenttask := currenttask.nexttask;\r
-    temptask.free;\r
-  end;\r
-  currenttask := nil;\r
-end;\r
-\r
-{------------------------------------------------------------------------------}\r
-\r
-procedure exitmessageloop;\r
-begin\r
-  postmessage(hwndwcore,WM_QUIT,0,0);\r
-end;\r
-\r
-  {$ifdef threadtimer}\r
-  'thread timer'\r
-  {$else}\r
-const timerid_wcore=$1000;\r
-  {$endif}\r
-\r
-function MyWindowProc(\r
-    ahWnd   : HWND;\r
-    auMsg   : Integer;\r
-    awParam : WPARAM;\r
-    alParam : LPARAM): Integer; stdcall;\r
-var\r
-    MsgRec : TMessage;\r
-    a:integer;\r
-begin\r
-  Result := 0;  // This means we handled the message\r
-\r
-  {MsgRec.hwnd    := ahWnd;}\r
-  MsgRec.wParam  := awParam;\r
-  MsgRec.lParam  := alParam;\r
-\r
-  dotasks;\r
-  case auMsg of\r
-    {$ifndef threadtimer}\r
-    WM_TIMER: begin\r
-      if msgrec.wparam = timerid_wcore then begin\r
-        a := wcore_timehandler;\r
-        killtimer(hwndwcore,timerid_wcore);\r
-        settimer(hwndwcore,timerid_wcore,a,nil);\r
-      end;\r
-    end;\r
-    {$endif}\r
-\r
-    {WINMSG_TASK:dotasks;}\r
-\r
-    WM_CLOSE: begin\r
-      {}\r
-    end;\r
-    WM_DESTROY: begin\r
-      {}\r
-    end;\r
-  else\r
-      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)\r
-  end;\r
-end;\r
-\r
-\r
-var\r
-  MyWindowClass : TWndClass = (style         : 0;\r
-                                 lpfnWndProc   : @MyWindowProc;\r
-                                 cbClsExtra    : 0;\r
-                                 cbWndExtra    : 0;\r
-                                 hInstance     : 0;\r
-                                 hIcon         : 0;\r
-                                 hCursor       : 0;\r
-                                 hbrBackground : 0;\r
-                                 lpszMenuName  : nil;\r
-                                 lpszClassName : 'wcoreClass');\r
-\r
-procedure messageloop;\r
-var\r
-  MsgRec : TMsg;\r
-begin\r
-\r
-  if Windows.RegisterClass(MyWindowClass) = 0 then halt;\r
-  //writeln('about to create wcore handle, hinstance=',hinstance);\r
-  hwndwcore := CreateWindowEx(WS_EX_TOOLWINDOW,\r
-                               MyWindowClass.lpszClassName,\r
-                               '',        { Window name   }\r
-                               WS_POPUP,  { Window Style  }\r
-                               0, 0,      { X, Y          }\r
-                               0, 0,      { Width, Height }\r
-                               0,         { hWndParent    }\r
-                               0,         { hMenu         }\r
-                               HInstance, { hInstance     }\r
-                               nil);      { CreateParam   }\r
-\r
-  if hwndwcore = 0 then halt;\r
-\r
-  {$ifdef threadtimer}\r
-  'thread timer'\r
-  {$else}\r
-  if settimer(hwndwcore,timerid_wcore,15,nil) = 0 then halt;\r
-  {$endif}\r
-\r
-\r
-  while GetMessage(MsgRec, 0, 0, 0) do begin\r
-    TranslateMessage(MsgRec);\r
-    DispatchMessage(MsgRec);\r
-    {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}\r
-  end;\r
-\r
-  if hWndwcore <> 0 then begin\r
-    DestroyWindow(hwndwcore);\r
-    hWndwcore := 0;\r
-  end;\r
-\r
-  {$ifdef threadtimer}\r
-  'thread timer'\r
-  {$else}\r
-  killtimer(hwndwcore,timerid_wcore);\r
-  {$endif}\r
-end;\r
-\r
-function ProcessMessage : Boolean;\r
-var\r
-    Msg : TMsg;\r
-begin\r
-    Result := FALSE;\r
-    if PeekMessage(Msg, hwndwcore, 0, 0, PM_REMOVE) then begin\r
-      Result := TRUE;\r
-      DispatchMessage(Msg);\r
-    end;\r
-end;\r
-\r
-procedure processmessages;\r
-begin\r
-  while processmessage do;\r
-end;\r
-\r
-\r
-end.\r

diff --git a/svn-commit.2.tmp b/svn-commit.2.tmp
deleted file mode 100755 (executable)
index 82b4cd3..0000000
--- a/svn-commit.2.tmp
+++ /dev/null
@@ -1,4 +0,0 @@
-initial import
---This line, and those below, will be ignored--
-
-A    .

diff --git a/svn-commit.3.tmp b/svn-commit.3.tmp
deleted file mode 100755 (executable)
index 82b4cd3..0000000
--- a/svn-commit.3.tmp
+++ /dev/null
@@ -1,4 +0,0 @@
-initial import
---This line, and those below, will be ignored--
-
-A    .

diff --git a/svn-commit.4.tmp b/svn-commit.4.tmp
deleted file mode 100755 (executable)
index 6588c17..0000000
--- a/svn-commit.4.tmp
+++ /dev/null
@@ -1,4 +0,0 @@
-create directory
---This line, and those below, will be ignored--
-
-A    svn+ssh://p10link/svnroot/lcore/trunk

diff --git a/svn-commit.5.tmp b/svn-commit.5.tmp
deleted file mode 100755 (executable)
index 82b4cd3..0000000
--- a/svn-commit.5.tmp
+++ /dev/null
@@ -1,4 +0,0 @@
-initial import
---This line, and those below, will be ignored--
-
-A    .

diff --git a/svn-commit.tmp b/svn-commit.tmp
deleted file mode 100755 (executable)
index 82b4cd3..0000000
--- a/svn-commit.tmp
+++ /dev/null
@@ -1,4 +0,0 @@
-initial import
---This line, and those below, will be ignored--
-
-A    .