From: plugwash <plugwash@p10link.net>
Date: Fri, 28 Mar 2008 02:26:58 +0000 (+0000)
Subject: initial import
X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b

initial import


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

4782a5c5afee47721cc617daa40dd29828342c2b
diff --git a/Makefile b/Makefile
new file mode 100755
index 0000000..2926076
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,23 @@
+all: lcoretest
+
+lcoretest: *.pas *.inc lcoretest.dpr
+	fpc -Sd -dipv6 lcoretest.dpr
+	
+clean:
+	-rm *.o
+	-rm *.ppu
+	-rm *.exe
+	-rm *.dcu
+	-rm lcoretest
+
+date := $(shell date +%Y%m%d)
+
+zip:
+	mkdir -p lcorewin32_$(date)
+	cp -a *.pas lcorewin32_$(date)
+	cp -a *.inc lcorewin32_$(date)
+	cp -a *.dpr lcorewin32_$(date)
+	cp -a Makefile lcorewin32_$(date)
+	-rm ../lcorewin32_$(date).zip
+	zip -r ../lcorewin32_$(date).zip lcorewin32_$(date)
+	rm -rf lcorewin32_$(date)
\ No newline at end of file
diff --git a/bfifo.pas b/bfifo.pas
new file mode 100755
index 0000000..55cc24a
--- /dev/null
+++ b/bfifo.pas
@@ -0,0 +1,148 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit bfifo;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+
+uses blinklist,pgtypes;
+
+const
+  pagesize=1420;
+
+type
+  tfifo=class(tobject)
+  private
+    l:tlinklist;     {add to}
+    getl:tlinklist; {remove from}
+    ofs:integer;
+    getofs:integer;
+  public
+    size:integer;
+    procedure add(data:pointer;len:integer);
+    function get(var resultptr:pointer;len:integer):integer;
+    procedure del(len:integer);
+    constructor create;
+    destructor destroy; override;
+  end;
+
+
+implementation
+
+var
+  testcount:integer;
+
+{
+
+xx1..... add
+xxxxxxxx
+....2xxx delete
+
+1 ofs
+2 getofs
+
+}
+
+procedure tfifo.add;
+var
+  a:integer;
+  p:tlinklist;
+begin
+  if len <= 0 then exit;
+  inc(size,len);
+  while len > 0 do begin
+    p := l;
+    if ofs = pagesize then begin
+      p := tplinklist.create;
+      if getl = nil then getl := p;
+      getmem(tplinklist(p).p,pagesize);
+      inc(testcount);
+      linklistadd(l,p);
+      ofs := 0;
+    end;
+    a := pagesize - ofs;
+    if len < a then a := len;
+    move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);
+    inc(taddrint(data),a);
+    dec(len,a);
+    inc(ofs,a);
+  end;
+end;
+
+function tfifo.get;
+var
+  p:tlinklist;
+  a:integer;
+begin
+  if len > size then len := size;
+  if len <= 0 then begin
+    result := 0;
+    resultptr := nil;
+    exit;
+  end;
+  p := getl;
+  resultptr := pointer(taddrint(tplinklist(p).p)+getofs);
+  result := pagesize-getofs;
+  if result > len then result := len;
+end;
+
+procedure tfifo.del;
+var
+  a:integer;
+  p,p2:tlinklist;
+begin
+  if len <= 0 then exit;
+  p := getl;
+  if len > size then len := size;
+  dec(size,len);
+
+  if len = 0 then exit;
+
+  while len > 0 do begin
+    a := pagesize-getofs;
+    if a > len then a := len;
+    inc(getofs,a);
+    dec(len,a);
+    if getofs = pagesize then begin
+      p2 := p.prev;
+      freemem(tplinklist(p).p);
+      dec(testcount);
+      linklistdel(l,p);
+      p.destroy;
+      p := p2;
+      getl := p;
+      getofs := 0;
+    end;
+  end;
+
+  if size = 0 then begin
+    if assigned(l) then begin
+      p := l;
+      freemem(tplinklist(p).p);
+      dec(testcount);
+      linklistdel(l,p);
+      p.destroy;
+      getl := nil;
+    end;
+    ofs := pagesize;
+    getofs := 0;
+  end;
+end;
+
+constructor tfifo.create;
+begin
+  ofs := pagesize;
+  inherited create;
+end;
+
+destructor tfifo.destroy;
+begin
+  del(size);
+  inherited destroy;
+end;
+
+end.
diff --git a/binipstuff.pas b/binipstuff.pas
new file mode 100755
index 0000000..ebb9f9c
--- /dev/null
+++ b/binipstuff.pas
@@ -0,0 +1,395 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit binipstuff;
+
+interface
+
+{$ifndef win32}
+{$ifdef ipv6}
+uses sockets;
+{$endif}
+{$endif}
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$ifdef cpu386}{$define i386}{$endif}
+{$ifdef i386}{$define ENDIAN_LITTLE}{$endif}
+
+{$include uint32.inc}
+
+const
+  hexchars:array[0..15] of char='0123456789abcdef';
+  AF_INET=2;
+  {$ifdef win32}
+    AF_INET6=23;
+  {$else}
+    AF_INET6=10;
+  {$endif}
+
+type
+  {$ifdef ipv6}
+    
+    {$ifdef win32}
+      {$define want_Tin6_addr}
+    {$endif}
+    {$ifdef ver1_0}
+      {$define want_Tin6_addr}
+    {$endif}
+    {$ifdef want_Tin6_addr}
+      Tin6_addr = packed record
+        case byte of
+          0: (u6_addr8  : array[0..15] of byte);
+          1: (u6_addr16 : array[0..7] of Word);
+          2: (u6_addr32 : array[0..3] of uint32);
+          3: (s6_addr8  : array[0..15] of shortint);
+          4: (s6_addr   : array[0..15] of shortint);
+          5: (s6_addr16 : array[0..7] of smallint);
+          6: (s6_addr32 : array[0..3] of LongInt);
+      end;
+    {$endif}
+  {$endif}
+
+  tbinip=record
+    family:integer;
+    {$ifdef ipv6}
+      case integer of
+        0: (ip:longint);
+        1: (ip6:tin6_addr);
+    {$else}
+      ip:longint;
+    {$endif}
+  end;
+
+  {$ifdef win32}
+    TInetSockAddr = packed Record
+      family:Word;
+      port  :Word;
+      addr  :uint32;
+      pad   :array [1..8] of byte;
+    end;
+    {$ifdef ipv6}
+
+      TInetSockAddr6 = packed record
+        sin6_family: word;
+        sin6_port: word;
+        sin6_flowinfo: uint32;
+        sin6_addr: tin6_addr;
+        sin6_scope_id: uint32;
+      end;
+    {$endif}
+  {$endif}
+
+function htons(w:word):word;
+function htonl(i:uint32):uint32;
+
+function ipstrtobin(const s:string;var binip:tbinip):boolean;
+function ipbintostr(const binip:tbinip):string;
+{$ifdef ipv6}
+function ip6bintostr(const bin:tin6_addr):string;
+function ip6strtobin(const s:string;var bin:tin6_addr):boolean;
+{$endif}
+
+function comparebinip(const ip1,ip2:tbinip):boolean;
+
+{deprecated}
+function longip(s:string):longint;
+
+procedure converttov4(var ip:tbinip);
+
+implementation
+
+uses sysutils;
+
+function htons(w:word):word;
+begin
+  {$ifdef ENDIAN_LITTLE}
+  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
+  {$else}
+  result := w;
+  {$endif}
+end;
+
+function htonl(i:uint32):uint32;
+begin
+  {$ifdef ENDIAN_LITTLE}
+  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
+  {$else}
+  result := i;
+  {$endif}
+end;
+
+{internal}
+{converts dotted v4 IP to longint. returns host endian order}
+function longip(s:string):longint;
+var
+  l:longint;
+  a,b:integer;
+function convertbyte(const s:string):integer;
+begin
+  result := strtointdef(s,-1);
+  if result < 0 then begin
+    result := -1;
+    exit;
+  end;
+  if result > 255 then begin
+    result := -1;
+    exit;
+  end;
+  {01 exception}
+  if (result <> 0) and (s[1] = '0') then begin
+    result := -1;
+    exit;
+  end;
+  {+1 exception}
+  if not (s[1] in ['0'..'9']) then begin
+    result := -1;
+    exit
+  end;
+end;
+
+begin
+  result := 0;
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := b shl 24;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 16;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 8;
+  s := copy(s,a+1,256);
+  b := convertbyte(copy(s,1,256));if (b < 0) then exit;
+  l := l or b;
+  result := l;
+end;
+
+
+function ipstrtobin(const s:string;var binip:tbinip):boolean;
+begin
+  binip.family := 0;
+  result := false;
+  {$ifdef ipv6}
+  if pos(':',s) <> 0 then begin
+    {try ipv6. use builtin routine}
+    result := ip6strtobin(s,binip.ip6);
+    if result then binip.family := AF_INET6;
+    exit;
+  end;
+  {$endif}
+
+  {try v4}
+  binip.ip := htonl(longip(s));
+  if (binip.ip <> 0) or (s = '0.0.0.0') then begin
+    result := true;
+    binip.family := AF_INET;
+    exit;
+  end;
+end;
+
+function ipbintostr(const binip:tbinip):string;
+var
+  a:integer;
+begin
+  result := '';
+  {$ifdef ipv6}
+  if binip.family = AF_INET6 then begin
+    result := ip6bintostr(binip.ip6);
+  end else
+  {$endif}
+  if binip.family = AF_INET then begin
+    a := htonl(binip.ip);
+    result := inttostr(a shr 24)+'.'+inttostr((a shr 16) and $ff)+'.'+inttostr((a shr 8) and $ff)+'.'+inttostr(a and $ff);
+  end;
+end;
+
+
+{------------------------------------------------------------------------------}
+
+{$ifdef ipv6}
+
+{
+IPv6 address binary to/from string conversion routines
+written by beware (steendijk at xs4all dot nl)
+
+- implementation does not depend on other ipv6 code such as the tin6_addr type,
+  the parameter can also be untyped.
+- it is host endian neutral - binary format is aways network order
+- it supports compression of zeroes
+- it supports ::ffff:192.168.12.34 style addresses
+- they are made to do the Right Thing, more efficient implementations are possible
+}
+
+{fpc has hostaddrtostr6 and strtohostaddr6 but the later isnt implemented yet}
+
+
+function ip6bintostr(const bin:tin6_addr):string;
+{base16 with lowercase output}
+function makehex(w:word):string;
+begin
+  result := '';
+  if w >= 4096 then result := result + hexchars[w shr 12];
+  if w >= 256 then result := result + hexchars[w shr 8 and $f];
+  if w >= 16 then result := result + hexchars[w shr 4 and $f];
+  result := result + hexchars[w and $f];
+end;
+
+var
+  a,b,c,addrlen:integer;
+  runbegin,runlength:integer;
+  bytes:array[0..15] of byte absolute bin;
+  words:array[0..7] of word;
+  dwords:array[0..3] of integer absolute words;
+begin
+  for a := 0 to 7 do begin
+    words[a] := bytes[a shl 1] shl 8 or bytes[a shl 1 or 1];
+  end;
+  if (dwords[0] = 0) and (dwords[1] = 0) and (words[4] = 0) and (words[5] = $ffff) then begin
+    {::ffff:/96 exception: v4 IP}
+    addrlen := 6;
+  end else begin
+    addrlen := 8;
+  end;
+  {find longest run of zeroes}
+  runbegin := 0;
+  runlength := 0;
+  for a := 0 to addrlen-1 do begin
+    if words[a] = 0 then begin
+      c := 0;
+      for b := a to addrlen-1 do if words[b] = 0 then begin
+        inc(c);
+      end else break;
+      if (c > runlength) then begin
+        runlength := c;
+        runbegin := a;
+      end;
+    end;
+  end;
+  result := '';
+  for a := 0 to runbegin-1 do begin
+    if (a <> 0) then result := result + ':';
+    result := result + makehex(words[a]);
+  end;
+  if runlength > 0 then result := result + '::';
+  c := runbegin+runlength;
+  for a := c to addrlen-1 do begin
+    if (a > c) then result := result + ':';
+    result := result + makehex(words[a]);
+  end;
+  if addrlen = 6 then begin
+    result := result + ':'+inttostr(bytes[12])+'.'+inttostr(bytes[13])+'.'+inttostr(bytes[14])+'.'+inttostr(bytes[15]);
+  end;
+end;
+
+function ip6strtobin(const s:string;var bin:tin6_addr):boolean;
+var
+  a,b:integer;
+  fields:array[0..7] of string;
+  fieldcount:integer;
+  emptyfield:integer;
+  wordcount:integer;
+  words:array[0..7] of word;
+  bytes:array[0..15] of byte absolute bin;
+begin
+  result := false;
+  for a := 0 to 7 do fields[a] := '';
+  fieldcount := 0;
+  for a := 1 to length(s) do begin
+    if s[a] = ':' then inc(fieldcount) else fields[fieldcount] := fields[fieldcount] + s[a];
+    if fieldcount > 7 then exit;
+  end;
+  if fieldcount < 2 then exit;
+
+  {find the empty field (compressed zeroes), not counting the first and last there may be at most 1}
+  emptyfield := -1;
+  for a := 1 to fieldcount-1 do begin
+    if fields[a] = '' then begin
+      if emptyfield = -1 then emptyfield := a else exit;
+    end;
+  end;
+
+  {check if last field is a valid v4 IP}
+  a := longip(fields[fieldcount]);
+  if (a <> 0) or (fields[fieldcount] = '0.0.0.0') then wordcount := 6 else wordcount := 8;
+  {0:1:2:3:4:5:6.6.6.6
+   0:1:2:3:4:5:6:7}
+  fillchar(words,sizeof(words),0);
+  if wordcount = 6 then begin
+    if fieldcount > 6 then exit;
+    words[6] := a shr 16;
+    words[7] := a and $ffff;
+  end;
+  if emptyfield = -1 then begin
+    {no run length: must be an exact number of fields}
+    if wordcount = 6 then begin
+      if fieldcount <> 6 then exit;
+      emptyfield := 5;
+    end else if wordcount = 8 then begin
+      if fieldcount <> 7 then exit;
+      emptyfield := 7;
+    end else exit;
+  end;
+  for a := 0 to emptyfield do begin
+    if fields[a] = '' then b := 0 else b := strtointdef('$'+fields[a],-1);
+    if (b < 0) or (b > $ffff) then exit;
+    words[a] := b;
+  end;
+  if wordcount = 6 then dec(fieldcount);
+  for a := wordcount-1 downto wordcount-(fieldcount-emptyfield) do begin
+    b := a+fieldcount-wordcount+1;
+    if fields[b] = '' then b := 0 else b := strtointdef('$'+fields[b],-1);
+    if (b < 0) or (b > $ffff) then exit;
+    words[a] := b;
+  end;
+  for a := 0 to 7 do begin
+    bytes[a shl 1] := words[a] shr 8;
+    bytes[a shl 1 or 1] := words[a] and $ff;
+  end;
+  result := true;
+end;
+{$endif}
+
+function comparebinip(const ip1,ip2:tbinip):boolean;
+begin
+  if (ip1.ip <> ip2.ip) then begin
+    result := false;
+    exit;
+  end;
+
+  {$ifdef ipv6}
+  if ip1.family = AF_INET6 then begin
+    if (ip1.ip6.s6_addr32[1] <> ip2.ip6.s6_addr32[1])
+    or (ip1.ip6.s6_addr32[2] <> ip2.ip6.s6_addr32[2])
+    or (ip1.ip6.s6_addr32[3] <> ip2.ip6.s6_addr32[3]) then begin
+      result := false;
+      exit;
+    end;
+  end;
+  {$endif}
+
+  result := (ip1.family = ip2.family);
+end;
+
+{converts a binary IP to v4 if it is a v6 IP in the v4 range}
+procedure converttov4(var ip:tbinip);
+begin
+  {$ifdef ipv6}
+  if ip.family = AF_INET6 then begin
+    if (ip.ip6.u6_addr32[0] = 0) and (ip.ip6.u6_addr32[1] = 0) and
+    (ip.ip6.u6_addr16[4] = 0) and (ip.ip6.u6_addr16[5] = $ffff) then begin
+      ip.family := AF_INET;
+      ip.ip := ip.ip6.s6_addr32[3];
+    end;
+  end;
+  {$endif}
+end;
+
+end.
diff --git a/blinklist.pas b/blinklist.pas
new file mode 100755
index 0000000..2079b75
--- /dev/null
+++ b/blinklist.pas
@@ -0,0 +1,118 @@
+(*
+ *  beware IRC services, blinklist.pas
+ *  Copyright (C) 2002 Bas Steendijk
+ *
+ *  This program is free software; you can redistribute it and/or modify
+ *  it under the terms of the GNU General Public License as published by
+ *  the Free Software Foundation; either version 2 of the License, or
+ *  (at your option) any later version.
+ *
+ *  This program is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with this program; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+unit blinklist;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+
+interface
+
+type
+  tlinklist=class(tobject)
+    next:tlinklist;
+    prev:tlinklist;
+    constructor create;
+    destructor destroy; override;
+  end;
+
+  {linklist with 2 links}
+  tlinklist2=class(tlinklist)
+    next2:tlinklist2;
+    prev2:tlinklist2;
+  end;
+
+  {linklist with one pointer}
+  tplinklist=class(tlinklist)
+    p:pointer
+  end;
+
+  tstringlinklist=class(tlinklist)
+    s:string;
+  end;
+
+  tthing=class(tlinklist)
+    name:string;      {name/nick}
+    hashname:integer; {hash of name}
+  end;
+
+{
+adding new block to list (baseptr)
+}
+procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
+procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
+
+
+procedure linklist2add(var baseptr,newptr:tlinklist2);
+procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
+
+var
+  linklistdebug:integer;
+
+implementation
+
+procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
+var
+  p:tlinklist;
+begin
+  p := baseptr;
+  baseptr := newptr;
+  baseptr.prev := nil;
+  baseptr.next := p;
+  if p <> nil then p.prev := baseptr;
+end;
+
+procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
+begin
+  if item = baseptr then baseptr := item.next;
+  if item.prev <> nil then item.prev.next := item.next;
+  if item.next <> nil then item.next.prev := item.prev;
+end;
+
+procedure linklist2add(var baseptr,newptr:tlinklist2);
+var
+  p:tlinklist2;
+begin
+  p := baseptr;
+  baseptr := newptr;
+  baseptr.prev2 := nil;
+  baseptr.next2 := p;
+  if p <> nil then p.prev2 := baseptr;
+end;
+
+procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
+begin
+  if item = baseptr then baseptr := item.next2;
+  if item.prev2 <> nil then item.prev2.next2 := item.next2;
+  if item.next2 <> nil then item.next2.prev2 := item.prev2;
+end;
+
+constructor tlinklist.create;
+begin
+  inherited create;
+  inc(linklistdebug);
+end;
+
+destructor tlinklist.destroy;
+begin
+  dec(linklistdebug);
+  inherited destroy;
+end;
+
+end.
diff --git a/bsearchtree.pas b/bsearchtree.pas
new file mode 100755
index 0000000..ad61751
--- /dev/null
+++ b/bsearchtree.pas
@@ -0,0 +1,101 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+  
+{actually a hashtable. it was a tree in earlier versions}
+
+unit bsearchtree;
+
+interface
+
+uses blinklist;
+
+const
+  hashtable_size=$4000;
+
+type
+  thashitem=class(tlinklist)
+    hash:integer;
+    s:string;
+    p:pointer;
+  end;
+  thashtable=array[0..hashtable_size-1] of thashitem;
+  phashtable=^thashtable;
+
+{adds "item" to the tree for name "s". the name must not exist (no checking done)}
+procedure addtree(t:phashtable;s:string;item:pointer);
+
+{removes name "s" from the tree. the name must exist (no checking done)}
+procedure deltree(t:phashtable;s:string);
+
+{returns the item pointer for s, or nil if not found}
+function findtree(t:phashtable;s:string):pointer;
+
+implementation
+
+function makehash(s:string):integer;
+const
+  shifter=6;
+var
+  a,b:integer;
+begin
+  result := 0;
+  b := length(s);
+  for a := 1 to b do begin
+    result := (result shl shifter) xor byte(s[a]);
+  end;
+  result := (result xor result shr 16) and (hashtable_size-1);
+end;
+
+procedure addtree(t:phashtable;s:string;item:pointer);
+var
+  hash:integer;
+  p:thashitem;
+begin
+  hash := makehash(s);
+  p := thashitem.create;
+  p.hash := hash;
+  p.s := s;
+  p.p := item;
+  linklistadd(tlinklist(t[hash]),tlinklist(p));
+end;
+
+procedure deltree(t:phashtable;s:string);
+var
+  p,p2:thashitem;
+  hash:integer;
+begin
+  hash := makehash(s);
+  p := t[hash];
+  p2 := nil;
+  while p <> nil do begin
+    if p.s = s then begin
+      p2 := p;
+      break;
+    end;
+    p := thashitem(p.next);
+  end;
+  linklistdel(tlinklist(t[hash]),tlinklist(p2));
+  p2.destroy;
+end;
+
+
+function findtree(t:phashtable;s:string):pointer;
+var
+  p:thashitem;
+  hash:integer;
+begin
+  result := nil;
+  hash := makehash(s);
+  p := t[hash];
+  while p <> nil do begin
+    if p.s = s then begin
+      result := p.p;
+      exit;
+    end;
+    p := thashitem(p.next);
+  end;
+end;
+
+end.
diff --git a/btime.pas b/btime.pas
new file mode 100755
index 0000000..3d672c4
--- /dev/null
+++ b/btime.pas
@@ -0,0 +1,362 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+{
+this unit returns unix timestamp with seconds and microseconds (as float)
+works on windows/delphi, and on freepascal on unix.
+}
+
+unit btime;
+
+interface
+
+type
+  float=extended;
+
+var
+  timezone:integer;
+  timezonestr:string;
+  irctime,unixtime:integer;
+  tickcount:integer;
+  settimebias:integer;
+  qpcjump:float; {can be read out and reset for debug purpose}
+  performancecountfreq:extended;
+
+function irctimefloat:float;
+function irctimeint:integer;
+
+function unixtimefloat:float;
+function unixtimeint:integer;
+
+function wintimefloat:float;
+
+procedure settime(newtime:integer);
+procedure gettimezone;
+procedure timehandler;
+procedure init;
+
+function timestring(i:integer):string;
+function timestrshort(i:integer):string;
+
+function oletounixfloat(t:float):float;
+function oletounix(t:tdatetime):integer;
+function unixtoole(i:integer):tdatetime;
+
+var
+  timefloatbias:float;
+  lastunixtimefloat:float=0;
+
+implementation
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  {$ifdef UNIX}
+    {$ifdef VER1_0}
+      linux,
+    {$else}
+      baseunix,unix,unixutil,{needed for 2.0.2}
+    {$endif}
+  {$else}
+    windows,
+  {$endif}
+  sysutils;
+
+  {$include unixstuff.inc}
+
+
+const
+  daysdifference=25569;
+
+function oletounixfloat(t:float):float;
+begin
+  t := (t - daysdifference) * 86400;
+  result := t;
+end;
+
+function oletounix(t:tdatetime):integer;
+begin
+  result := trunc(oletounixfloat(t));
+end;
+
+function unixtoole(i:integer):tdatetime;
+begin
+  result := ((i)/86400)+daysdifference;
+end;
+
+{$ifdef unix}
+{-----------------------------------------*nix/freepascal code to read time }
+
+function unixtimefloat:float;
+var
+  tv:ttimeval;
+begin
+  gettimeofday(tv);
+  result := tv.tv_sec+(tv.tv_usec/1000000);
+end;
+
+function wintimefloat:extended;
+begin
+  result := unixtimefloat;
+end;
+
+function unixtimeint:integer;
+var
+  tv:ttimeval;
+begin
+  gettimeofday(tv);
+  result := tv.tv_sec;
+end;
+
+{$else} {delphi 3}
+{------------------------------ windows/delphi code to read time}
+
+{ free pascals tsystemtime is incomaptible with windows api calls
+ so we declare it ourselves - plugwash
+}
+{$ifdef fpc}
+type
+  TSystemTime = record
+     wYear: Word;
+     wMonth: Word;
+     wDayOfWeek: Word;
+     wDay: Word;
+     wHour: Word;
+     wMinute: Word;
+     wSecond: Word;
+     wMilliseconds: Word;
+  end;
+ {$endif}
+function Date_utc: extended;
+var
+  SystemTime: TSystemTime;
+begin
+  {$ifdef fpc}
+    GetsystemTime(@SystemTime);
+  {$else}
+    GetsystemTime(SystemTime);
+  {$endif}
+  with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);
+end;
+
+function Time_utc: extended;
+var
+  SystemTime: TSystemTime;
+begin
+  {$ifdef fpc}
+    GetsystemTime(@SystemTime);
+  {$else}
+    GetsystemTime(SystemTime);
+  {$endif}
+  with SystemTime do
+    Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+end;
+
+function Now_utc: extended;
+begin
+  Result := round(Date_utc) + Time_utc;
+end;
+
+const
+  highdwordconst=4294967296.0;
+
+function wintimefloat:extended;
+var
+  p:packed record
+    lowpart:longint;
+    highpart:longint
+  end;
+  p2:tlargeinteger absolute p;
+  e:extended;
+begin
+  if performancecountfreq = 0 then begin
+    QueryPerformancefrequency(p2);
+    e := p.lowpart;
+    if e < 0 then e := e + highdwordconst;
+    performancecountfreq := ((p.highpart*highdwordconst)+e);
+  end;
+  queryperformancecounter(p2);
+  e := p.lowpart;
+  if e < 0 then e := e + highdwordconst;
+  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
+end;
+
+var
+  classpriority,threadpriority:integer;
+
+procedure settc;
+var
+  hprocess,hthread:integer;
+begin
+  hProcess := GetCurrentProcess;
+  hThread := GetCurrentThread;
+
+  ClassPriority := GetPriorityClass(hProcess);
+  ThreadPriority := GetThreadPriority(hThread);
+
+  SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
+  SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
+end;
+
+procedure unsettc;
+var
+  hprocess,hthread:integer;
+begin
+  hProcess := GetCurrentProcess;
+  hThread := GetCurrentThread;
+
+  SetPriorityClass(hProcess, ClassPriority);
+  SetThreadPriority(hThread,  ThreadPriority);
+end;
+
+function unixtimefloat:float;
+var
+  f,g,h:float;
+begin
+  if timefloatbias = 0 then begin
+    settc;
+    f := now_utc;
+    repeat g := now_utc; h := wintimefloat until g > f;
+    timefloatbias := oletounixfloat(g)-h;
+    unsettc;
+  end;
+  result := wintimefloat+timefloatbias;
+
+  {
+  workaround for QPC jumps
+  (approach 2: always check "hi res" QPC unixtime against the "guaranteed" systemtime one)
+  }
+  f := result-(oletounixfloat(now_utc));
+  if abs(f) > 0.02 then begin
+    f := timefloatbias;
+    timefloatbias := 0;
+    result := unixtimefloat;
+    qpcjump := qpcjump + f - timefloatbias;
+  end;
+
+  if (result <= lastunixtimefloat) then result := lastunixtimefloat + 0.0000001;
+  lastunixtimefloat := result;
+end;
+
+function unixtimeint:integer;
+begin
+  result := trunc(unixtimefloat);
+end;
+
+{$endif}
+{-----------------------------------------------end of platform specific}
+
+function irctimefloat:float;
+begin
+  result := unixtimefloat+settimebias;
+end;
+
+function irctimeint:integer;
+begin
+  result := unixtimeint+settimebias;
+end;
+
+
+procedure settime(newtime:integer);
+var
+  a:integer;
+begin
+  a := irctimeint-settimebias;
+  if newtime = 0 then settimebias := 0 else settimebias := newtime-a;
+
+  irctime := irctimeint;
+end;
+
+procedure timehandler;
+begin
+  if unixtime = 0 then init;
+  unixtime := unixtimeint;
+  irctime := irctimeint;
+  if unixtime and 63 = 0 then begin
+    {update everything, apply timezone changes, clock changes, etc}
+    gettimezone;
+    timefloatbias := 0;
+    unixtime := unixtimeint;
+    irctime := irctimeint;
+  end;
+end;
+
+
+procedure gettimezone;
+var
+  {$ifdef UNIX}
+    {$ifndef ver1_9_4}
+      {$ifndef ver1_0}
+        {$define above194}
+      {$endif}
+    {$endif}
+    {$ifndef above194}
+      hh,mm,ss:word;
+    {$endif}
+  {$endif}
+  l:integer;
+begin
+  {$ifdef UNIX}
+    {$ifdef above194}
+      timezone := tzseconds;
+    {$else}
+      gettime(hh,mm,ss);
+      timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
+    {$endif}
+  {$else}
+  timezone := round((now-now_utc)*86400);
+  {$endif}
+
+  while timezone > 43200 do dec(timezone,86400);
+  while timezone < -43200 do inc(timezone,86400);
+
+  if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
+  l := abs(timezone) div 60;
+  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);
+end;
+
+function timestrshort(i:integer):string;
+const
+  weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');
+  month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+
+  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
+  inttostr(y);
+end;
+
+function timestring(i:integer):string;
+const
+  weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');
+  month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+
+  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
+  timezonestr;
+end;
+
+procedure init;
+begin
+  qpcjump := 0;
+  settimebias := 0;
+  gettimezone;
+  unixtime := unixtimeint;
+  irctime := irctimeint;
+end;
+
+end.
diff --git a/dnsasync.pas b/dnsasync.pas
new file mode 100755
index 0000000..0a32459
--- /dev/null
+++ b/dnsasync.pas
@@ -0,0 +1,247 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+//FIXME: this code only ever seems to use one dns server for a request and does
+//not seem to have any form of retry code.
+
+unit dnsasync;
+
+interface
+
+uses
+  {$ifdef win32}
+    dnswin,
+  {$endif}
+  lsocket,lcore,
+  classes,binipstuff,dnscore,btime;
+
+
+type
+  //after completion or cancelation a dnswinasync may be reused
+  tdnsasync=class(tcomponent)
+
+  private
+    //made a load of stuff private that does not appear to be part of the main
+    //public interface. If you make any of it public again please consider the
+    //consequences when using windows dns. --plugwash.
+    sock:twsocket;
+
+    sockopen:boolean;
+
+
+    state:tdnsstate;
+
+    dnsserverid:integer;
+    startts:double;
+    {$ifdef win32}
+      dwas : tdnswinasync;
+    {$endif}
+
+
+    procedure asyncprocess;
+    procedure receivehandler(sender:tobject;error:word);
+    function sendquery(const packet:tdnspacket;len:integer):boolean;
+    {$ifdef win32}
+      procedure winrequestdone(sender:tobject;error:word);
+    {$endif}
+  public
+    onrequestdone:tsocketevent;
+
+    //addr and port allow the application to specify a dns server specifically
+    //for this dnsasync object. This is not a reccomended mode of operation
+    //because it limits the app to one dns server but is kept for compatibility
+    //and special uses.
+    addr,port:string;
+
+    //A family value of AF_INET6 will give only
+    //ipv6 results. Any other value will give ipv4 results in preference and ipv6
+    //results if ipv4 results are not available;
+    forwardfamily:integer;
+
+    procedure cancel;//cancel an outstanding dns request
+    function dnsresult:string; //get result of dnslookup as a string
+    procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
+    procedure forwardlookup(const name:string); //start forward lookup,
+                                                //preffering ipv4
+    procedure reverselookup(const binip:tbinip); //start reverse lookup
+
+    constructor create(aowner:tcomponent); override;
+    destructor destroy; override;
+
+  end;
+
+implementation
+
+uses sysutils;
+
+constructor tdnsasync.create;
+begin
+  inherited create(aowner);
+  dnsserverid := -1;
+  sock := twsocket.create(self);
+end;
+
+destructor tdnsasync.destroy;
+begin
+  if dnsserverid >= 0 then begin
+    reportlag(dnsserverid,-1);
+    dnsserverid := -1;
+  end;
+  sock.release;
+  setstate_request_init('',state);
+  inherited destroy;
+end;
+
+procedure tdnsasync.receivehandler;
+begin
+  if dnsserverid >= 0 then begin
+    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));
+    dnsserverid := -1;
+  end;
+{  writeln('received reply');}
+  fillchar(state.recvpacket,sizeof(state.recvpacket),0);
+  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));
+  state.parsepacket := true;
+  asyncprocess;
+end;
+
+function tdnsasync.sendquery;
+begin
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+  result := false;
+  if len = 0 then exit; {no packet}
+  if not sockopen then begin
+    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;
+    startts := unixtimefloat;
+    if port = '' then port := '53';
+    sock.port := port;
+    sock.Proto := 'udp';
+    sock.ondataavailable := receivehandler;
+    try
+      sock.connect;
+    except
+      on e:exception do begin
+        //writeln('exception '+e.message);
+        exit;
+      end;
+    end;
+    sockopen := true;
+  end;
+  sock.send(@packet,len);
+  result := true;
+end;
+
+procedure tdnsasync.asyncprocess;
+begin
+  state_process(state);
+  case state.resultaction of
+    action_ignore: begin {do nothing} end;
+    action_done: begin
+      onrequestdone(self,0);
+    end;
+    action_sendquery:begin
+      sendquery(state.sendpacket,state.sendpacketlen);
+    end;
+  end;
+end;
+
+procedure tdnsasync.forwardlookup;
+begin
+
+  ipstrtobin(name,state.resultbin);
+
+  {$ifdef win32}
+    if usewindns or (addr = '') then begin
+      dwas := tdnswinasync.create;
+      dwas.onrequestdone := winrequestdone;
+      if forwardfamily = AF_INET6 then begin
+        dwas.forwardlookup(name,true);
+      end else begin
+        dwas.forwardlookup(name,false);
+      end;
+      exit;
+    end;
+  {$endif}
+
+
+  if state.resultbin.family <> 0 then begin
+    onrequestdone(self,0);
+    exit;
+  end;
+
+
+  setstate_forward(name,state,forwardfamily);
+  asyncprocess;
+
+end;
+
+procedure tdnsasync.reverselookup;
+
+begin
+  {$ifdef win32}
+    if usewindns or (addr = '') then begin
+      dwas := tdnswinasync.create;
+      dwas.onrequestdone := winrequestdone;
+      dwas.reverselookup(binip);
+      exit;
+    end;
+  {$endif}
+
+  setstate_reverse(binip,state);
+  asyncprocess;
+end;
+
+function tdnsasync.dnsresult;
+begin
+  if state.resultstr <> '' then result := state.resultstr else begin
+    result := ipbintostr(state.resultbin);
+  end;
+end;
+
+procedure tdnsasync.dnsresultbin(var binip:tbinip);
+begin
+  move(state.resultbin,binip,sizeof(binip));
+end;
+
+procedure tdnsasync.cancel;
+begin
+  {$ifdef win32}
+    if assigned(dwas) then begin
+      dwas.release;
+      dwas := nil;
+    end else 
+  {$endif}
+  begin
+
+    if dnsserverid >= 0 then begin
+      reportlag(dnsserverid,-1);
+      dnsserverid := -1;
+    end;
+    if sockopen then begin
+      sock.close;
+      sockopen := false;
+    end;
+  end;
+  setstate_failure(state);
+  onrequestdone(self,0);
+end;
+
+{$ifdef win32}
+  procedure tdnsasync.winrequestdone(sender:tobject;error:word);
+ 
+  begin
+    if dwas.reverse then begin 
+      state.resultstr := dwas.name;
+    end else begin 
+      state.resultbin := dwas.ip;
+      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin
+        fillchar(state.resultbin,sizeof(tbinip),0);
+      end;
+    end;
+    dwas.release;
+    onrequestdone(self,error);
+  end;
+{$endif}
+end.
diff --git a/dnscore.pas b/dnscore.pas
new file mode 100755
index 0000000..bb4fab4
--- /dev/null
+++ b/dnscore.pas
@@ -0,0 +1,728 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+{
+
+  code wanting to use this dns system should act as follows (note: app
+  developers will probablly want to use dnsasync or dnssync or write a similar
+  wrapper unit of thier own).
+
+  for normal lookups call setstate_forward or setstate_reverse to set up the
+  state, for more obscure lookups use setstate_request_init and fill in other
+  relavent state manually.
+
+  call state_process which will do processing on the information in the state
+  and return an action
+  action_ignore means that dnscore wants the code that calls it to go
+  back to waiting for packets
+  action_sendpacket means that dnscore wants the code that calls it to send
+  the packet in sendpacket/sendpacketlen and then start (or go back to) listening
+  for
+  action_done means the request has completed (either suceeded or failed)
+
+  callers should resend the last packet they tried to send if they have not
+  been asked to send a new packet for more than some timeout value they choose.
+
+  when a packet is received the application should put the packet in
+  recvbuf/recvbuflen , set state.parsepacket and call state_process again
+
+  once the app gets action_done it can determine sucess or failure in the
+  following ways.
+
+  on failure state.resultstr will be an empty string and state.resultbin will
+  be zeroed out (easilly detected by the fact that it will have a family of 0)
+
+  on success for a A or AAAA lookup state.resultstr will be an empty string
+  and state.resultbin will contain the result (note: AAAA lookups require IPV6
+  enabled).
+
+  if an A lookup fails and the code is built with ipv6 enabled then the code
+  will return any AAAA records with the same name. The reverse does not apply
+  so if an application preffers IPV6 but wants IPV4 results as well it must
+  check them seperately.
+
+  on success for any other type of lookup state.resultstr will be an empty
+
+  note the state contains ansistrings, setstate_init with a null name parameter
+  can be used to clean theese up if required.
+
+  callers may use setstate_failure to mark the state as failed themseleves
+  before passing it on to other code, for example this may be done in the event
+  of a timeout.
+}
+unit dnscore;
+
+
+
+{$ifdef fpc}{$mode delphi}{$endif}
+
+
+
+
+
+interface
+
+uses binipstuff,classes,pgtypes;
+
+var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
+//hint to users of this unit that they should use windows dns instead.
+//May be disabled by applications if desired. (e.g. if setting a custom
+//dnsserverlist).
+
+//note: this unit will not be able to self populate it's dns server list on
+//older versions of windows.
+
+const
+  maxnamelength=127;
+  maxnamefieldlen=63;
+  //note: when using action_ignore the dnscore code *must* preserve the contents of state.sendpacket to allow for retries
+  //note: action_ignore must not be used in response to the original request but there is no valid reason for doing this anyway
+  action_ignore=0;
+  action_done=1;
+  action_sendquery=2;
+  querytype_a=1;
+  querytype_cname=5;
+  querytype_aaaa=28;
+  querytype_ptr=12;
+  querytype_ns=2;
+  querytype_soa=6;
+  querytype_mx=15;
+
+  maxrecursion=10;
+  maxrrofakind=20;
+
+  retryafter=300000; //microseconds must be less than one second;
+  timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
+type
+  dvar=array[0..0] of byte;
+  pdvar=^dvar;
+  tdnspacket=packed record
+    id:word;
+    flags:word;
+    rrcount:array[0..3] of word;
+    payload:array[0..511-12] of byte;
+  end;
+
+
+
+  tdnsstate=record
+    id:word;
+    recursioncount:integer;
+    queryname:string;
+    requesttype:word;
+    parsepacket:boolean;
+    resultstr:string;
+    resultbin:tbinip;
+    resultaction:integer;
+    numrr1:array[0..3] of integer;
+    numrr2:integer;
+    rrdata:string;
+    sendpacketlen:integer;
+    sendpacket:tdnspacket;
+    recvpacketlen:integer;
+    recvpacket:tdnspacket;
+    forwardfamily:integer;
+  end;
+
+  trr=packed record
+    requesttypehi:byte;
+    requesttype:byte;
+    clas:word;
+    ttl:integer;
+    datalen:word;
+    data:array[0..511] of byte;
+  end;
+
+  trrpointer=packed record
+    p:pointer;
+    ofs:integer;
+    len:integer;
+    namelen:integer;
+  end;
+
+//commenting out functions from interface that do not have documented semantics
+//and probablly should not be called from outside this unit, reenable them
+//if you must but please document them at the same time --plugwash
+
+//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
+//function makereversename(const binip:tbinip):string;
+
+procedure setstate_request_init(const name:string;var state:tdnsstate);
+
+//set up state for a foward lookup. A family value of AF_INET6 will give only
+//ipv6 results. Any other value will give ipv4 results in preference and ipv6
+//results if ipv4 results are not available;
+procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+
+procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
+procedure setstate_failure(var state:tdnsstate);
+//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+
+
+procedure state_process(var state:tdnsstate);
+
+//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
+
+//presumablly this is exported to allow more secure random functions
+//to be substituted?
+var randomfunction:function:integer;
+
+
+procedure populatednsserverlist;
+procedure cleardnsservercache;
+
+var
+  dnsserverlist : tstringlist;
+//  currentdnsserverno : integer;
+
+function getcurrentsystemnameserver(var id:integer) :string;
+
+//var
+//  unixnameservercache:string;
+{ $endif}
+
+
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+var
+  failurereason:string;
+
+implementation
+
+uses
+  {$ifdef win32}
+    windows,
+  {$endif}
+
+  sysutils;
+
+function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
+var
+  a,b:integer;
+  s:string;
+  arr:array[0..sizeof(packet)-1] of byte absolute packet;
+begin
+ { writeln('buildrequest: name: ',name);}
+  result := 0;
+  fillchar(packet,sizeof(packet),0);
+  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);
+  packet.flags := htons($0100);
+  packet.rrcount[0] := htons($0001);
+
+
+  s := copy(name,1,maxnamelength);
+  if s = '' then exit;
+  if s[length(s)] <> '.' then s := s + '.';
+  b := 0;
+  {encode name}
+  if (s = '.') then begin
+    packet.payload[0] := 0;
+    result := 12+5;
+  end else begin
+    for a := 1 to length(s) do begin
+      if s[a] = '.' then begin
+        if b > maxnamefieldlen then exit;
+        if (b = 0) then exit;
+        packet.payload[a-b-1] := b;
+        b := 0;
+      end else begin
+        packet.payload[a] := byte(s[a]);
+        inc(b);
+      end;
+    end;
+    if b > maxnamefieldlen then exit;
+    packet.payload[length(s)-b] := b;
+    result := length(s) + 12+5;
+  end;
+
+  arr[result-1] := 1;
+  arr[result-3] := requesttype and $ff;
+  arr[result-4] := requesttype shr 8;
+end;
+
+function makereversename(const binip:tbinip):string;
+var
+  name:string;
+  a,b:integer;
+begin
+  name := '';
+  if binip.family = AF_INET then begin
+    b := htonl(binip.ip);
+    for a := 0 to 3 do begin
+      name := name + inttostr(b shr (a shl 3) and $ff)+'.';
+    end;
+    name := name + 'in-addr.arpa';
+  end else
+  {$ifdef ipv6}
+  if binip.family = AF_INET6 then begin
+    for a := 15 downto 0 do begin
+      b := binip.ip6.u6_addr8[a];
+      name := name + hexchars[b and $f]+'.'+hexchars[b shr 4]+'.';
+    end;
+    name := name + 'ip6.arpa';
+  end else
+  {$endif}
+  begin
+    {empty name}
+  end;
+  result := name;
+end;
+
+{
+decodes DNS format name to a string. does not includes the root dot.
+doesnt read beyond len.
+empty result + non null failurereason: failure
+empty result + null failurereason: internal use
+}
+function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
+var
+  arr:array[0..sizeof(packet)-1] of byte absolute packet;
+  s:string;
+  a,b:integer;
+begin
+  numread := 0;
+  repeat
+    if (start+numread < 0) or (start+numread >= len) then begin
+      result := '';
+      failurereason := 'decoding name: got out of range1';
+      exit;
+    end;
+    b := arr[start+numread];
+    if b >= $c0 then begin
+      {recursive sub call}
+      if recursion > 10 then begin
+        result := '';
+        failurereason := 'decoding name: max recursion';
+        exit;
+      end;
+      if ((start+numread+1) >= len) then begin
+        result := '';
+        failurereason := 'decoding name: got out of range3';
+        exit;
+      end;
+      a := ((b shl 8) or arr[start+numread+1]) and $3fff;
+      s := decodename(packet,len,a,recursion+1,a);
+      if (s = '') and (failurereason <> '') then begin
+        result := '';
+        exit;
+      end;
+      if result <> '' then result := result + '.';
+      result := result + s;
+      inc(numread,2);
+      exit;
+    end else if b < 64 then begin
+      if (numread <> 0) and (b <> 0) then result := result + '.';
+      for a := start+numread+1 to start+numread+b do begin
+        if (a >= len) then begin
+          result := '';
+          failurereason := 'decoding name: got out of range2';
+          exit;
+        end;
+        result := result + char(arr[a]);
+      end;
+      inc(numread,b+1);
+
+      if b = 0 then begin
+        if (result = '') and (recursion = 0) then result := '.';
+        exit; {reached end of name}
+      end;
+    end else begin
+      failurereason := 'decoding name: read invalid char';
+      result := '';
+      exit; {invalid}
+    end;
+  until false;
+end;
+
+{==============================================================================}
+
+procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+var
+  a:integer;
+begin
+  state.resultaction := action_done;
+  state.resultstr := '';
+  case trr(rrp.p^).requesttype of
+    querytype_a: begin
+      if htons(trr(rrp.p^).datalen) <> 4 then exit;
+      move(trr(rrp.p^).data,state.resultbin.ip,4);
+      state.resultbin.family :=AF_INET;
+    end;
+    {$ifdef ipv6}
+    querytype_aaaa: begin
+      if htons(trr(rrp.p^).datalen) <> 16 then exit;
+      state.resultbin.family := AF_INET6;
+      move(trr(rrp.p^).data,state.resultbin.ip6,16);
+    end;
+    {$endif}
+  else
+    {other reply types (PTR, MX) return a hostname}
+    state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
+    fillchar(state.resultbin,sizeof(state.resultbin),0);
+  end;
+end;
+
+procedure setstate_request_init(const name:string;var state:tdnsstate);
+begin
+  {destroy things properly}
+  state.resultstr := '';
+  state.queryname := '';
+  state.rrdata := '';
+  fillchar(state,sizeof(state),0);
+  state.queryname := name;
+  state.parsepacket := false;
+end;
+
+procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+begin
+  setstate_request_init(name,state);
+  state.forwardfamily := family;
+  {$ifdef ipv6}
+  if family = AF_INET6 then state.requesttype := querytype_aaaa else
+  {$endif}
+  state.requesttype := querytype_a;
+end;
+
+procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
+begin
+  setstate_request_init(makereversename(binip),state);
+  state.requesttype := querytype_ptr;
+end;
+
+procedure setstate_failure(var state:tdnsstate);
+begin
+  state.resultstr := '';
+  fillchar(state.resultbin,sizeof(state.resultbin),0);
+  state.resultaction := action_done;
+end;
+
+procedure state_process(var state:tdnsstate);
+label recursed;
+label failure;
+var
+  a,b,ofs:integer;
+  rrtemp:^trr;
+  rrptemp:^trrpointer;
+begin
+  if state.parsepacket then begin
+    if state.recvpacketlen < 12 then begin
+      failurereason := 'Undersized packet';
+      state.resultaction := action_ignore;
+      exit;
+    end;
+    if state.id <> state.recvpacket.id then begin
+      failurereason := 'ID mismatch';
+      state.resultaction := action_ignore;
+      exit;
+    end;
+    state.numrr2 := 0;
+    for a := 0 to 3 do begin
+      state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
+      if state.numrr1[a] > maxrrofakind then goto failure;
+      inc(state.numrr2,state.numrr1[a]);
+    end;
+
+    setlength(state.rrdata,state.numrr2*sizeof(trrpointer));
+
+    {- put all replies into a list}
+
+    ofs := 12;
+    {get all queries}
+    for a := 0 to state.numrr1[0]-1 do begin
+      if (ofs < 12) or (ofs > state.recvpacketlen-4) then goto failure;
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrptemp.p := @state.recvpacket.payload[ofs-12];
+      rrptemp.ofs := ofs;
+      decodename(state.recvpacket,state.recvpacketlen,ofs,0,b);
+      rrptemp.len := b + 4;
+      inc(ofs,rrptemp.len);
+    end;
+
+    for a := state.numrr1[0] to state.numrr2-1 do begin
+      if (ofs < 12) or (ofs > state.recvpacketlen-12) then goto failure;
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      if decodename(state.recvpacket,state.recvpacketlen,ofs,0,b) = '' then goto failure;
+      rrtemp := @state.recvpacket.payload[ofs-12+b]; {rrtemp points to values and result, after initial name}
+      rrptemp.p := rrtemp;
+      rrptemp.ofs := ofs; {ofs is start of RR before initial name from start of packet}
+      rrptemp.namelen := b;
+      b := htons(rrtemp.datalen);
+      rrptemp.len := b + 10 + rrptemp.namelen;
+      inc(ofs,rrptemp.len);
+    end;
+    if (ofs <> state.recvpacketlen) then begin
+      failurereason := 'ofs <> state.packetlen';
+      goto failure;
+    end;
+
+    {- check for items of the requested type in answer section, if so return success first}
+    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrtemp := rrptemp.p;
+      b := rrptemp.len;
+      if rrtemp.requesttype = state.requesttype then begin
+        setstate_return(rrptemp^,b,state);
+        exit;
+      end;
+    end;
+
+    {if no items of correct type found, follow first cname in answer section}
+    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrtemp := rrptemp.p;
+      b := rrptemp.len;
+      if rrtemp.requesttype = querytype_cname then begin
+        state.queryname := decodename(state.recvpacket,state.recvpacketlen,rrptemp.ofs+12,0,b);
+        goto recursed;
+      end;
+    end;
+
+    {no cnames found, no items of correct type found}
+    if state.forwardfamily <> 0 then goto failure;
+{$ifdef ipv6}
+    if (state.requesttype = querytype_a) then begin
+      {v6 only: in case of forward, look for AAAA in alternative section}
+      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin
+        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+        rrtemp := rrptemp.p;
+        b := rrptemp.len;
+        if rrtemp.requesttype = querytype_aaaa then begin
+          setstate_return(rrptemp^,b,state);
+          exit;
+        end;
+      end;
+      {no AAAA's found in alternative, do a recursive lookup for them}
+      state.requesttype := querytype_aaaa;
+      goto recursed;
+    end;
+{$endif}
+    goto failure;
+recursed:
+    {here it needs recursed lookup}
+    {if needing to follow a cname, change state to do so}
+    inc(state.recursioncount);
+    if state.recursioncount > maxrecursion then goto failure;
+  end;
+
+  {here, a name needs to be resolved}
+  if state.queryname = '' then begin
+    failurereason := 'empty query name';
+    goto failure;
+  end;
+
+  {do /ets/hosts lookup here}
+  state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
+  if state.sendpacketlen = 0 then begin
+    failurereason := 'building request packet failed';
+    goto failure;
+  end;
+  state.id := state.sendpacket.id;
+  state.resultaction := action_sendquery;
+
+  exit;
+failure:
+  setstate_failure(state);
+end;
+{$ifdef win32}
+  const
+    MAX_HOSTNAME_LEN = 132;
+    MAX_DOMAIN_NAME_LEN = 132;
+    MAX_SCOPE_ID_LEN = 260    ;
+    MAX_ADAPTER_NAME_LENGTH = 260;
+    MAX_ADAPTER_ADDRESS_LENGTH = 8;
+    MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
+    ERROR_BUFFER_OVERFLOW = 111;
+    MIB_IF_TYPE_ETHERNET = 6;
+    MIB_IF_TYPE_TOKENRING = 9;
+    MIB_IF_TYPE_FDDI = 15;
+    MIB_IF_TYPE_PPP = 23;
+    MIB_IF_TYPE_LOOPBACK = 24;
+    MIB_IF_TYPE_SLIP = 28;
+
+
+  type
+    tip_addr_string=packed record
+      Next :pointer;
+      IpAddress : array[0..15] of char;
+      ipmask    : array[0..15] of char;
+      context   : dword;
+    end;
+    pip_addr_string=^tip_addr_string;
+    tFIXED_INFO=packed record
+       HostName         : array[0..MAX_HOSTNAME_LEN-1] of char;
+       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of char;
+       currentdnsserver : pip_addr_string;
+       dnsserverlist    : tip_addr_string;
+       nodetype         : longint;
+       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of char;
+       enablerouting    : longbool;
+       enableproxy      : longbool;
+       enabledns        : longbool;
+    end;
+    pFIXED_INFO=^tFIXED_INFO;
+
+  var
+    iphlpapi : thandle;
+    getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
+{$endif}
+procedure populatednsserverlist;
+var
+  {$ifdef win32}
+    fixed_info : pfixed_info;
+    fixed_info_len : longint;
+    currentdnsserver : pip_addr_string;
+  {$else}
+    t:textfile;
+    s:string;
+    a:integer;
+  {$endif}
+begin
+  //result := '';
+  if assigned(dnsserverlist) then begin
+    dnsserverlist.clear;
+  end else begin
+    dnsserverlist := tstringlist.Create;
+  end;
+  {$ifdef win32}
+    if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
+    if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
+    fixed_info_len := 0;
+    if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
+    //fixed_info_len :=sizeof(tfixed_info);
+    getmem(fixed_info,fixed_info_len);
+    if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
+      freemem(fixed_info);
+      exit;
+    end;
+    currentdnsserver := @(fixed_info.dnsserverlist);
+    while assigned(currentdnsserver) do begin
+      dnsserverlist.Add(currentdnsserver.IpAddress);
+      currentdnsserver := currentdnsserver.next;
+    end;
+    freemem(fixed_info);
+  {$else}
+    filemode := 0;
+    assignfile(t,'/etc/resolv.conf');
+    {$i-}reset(t);{$i+}
+    if ioresult <> 0 then exit;
+
+    while not eof(t) do begin
+      readln(t,s);
+      if not (copy(s,1,10) = 'nameserver') then continue;
+      s := copy(s,11,500);
+      while s <> '' do begin
+        if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
+      end;
+      a := pos(' ',s);
+      if a <> 0 then s := copy(s,1,a-1);
+      a := pos(#9,s);
+      if a <> 0 then s := copy(s,1,a-1);
+      //result := s;
+      //if result <> '' then break;
+      dnsserverlist.Add(s);
+    end;
+    close(t);
+  {$endif}
+end;
+
+procedure cleardnsservercache;
+begin
+  if assigned(dnsserverlist) then begin
+    dnsserverlist.destroy;
+    dnsserverlist := nil;
+  end;
+end;
+
+function getcurrentsystemnameserver(var id:integer):string;
+var 
+  counter : integer;
+
+begin
+  if not assigned(dnsserverlist) then populatednsserverlist;
+  if dnsserverlist.count=0 then raise exception.create('no dns servers availible');
+  id := 0;
+  if dnsserverlist.count >1 then begin
+
+    for counter := 1 to dnsserverlist.count-1 do begin
+      if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;
+    end;
+  end;
+  result := dnsserverlist[id]
+end;
+
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+var
+  counter : integer;
+  temp : integer;
+begin
+  if (id < 0) or (id >= dnsserverlist.count) then exit;
+  if lag = -1 then lag := timeoutlag;
+  for counter := 0 to dnsserverlist.count-1 do begin
+    temp := taddrint(dnsserverlist.objects[counter]) *15;
+    if counter=id then temp := temp + lag;
+    dnsserverlist.objects[counter] := tobject(temp div 16);
+  end;
+
+end;
+
+{  quick and dirty description of dns packet structure to aid writing and
+   understanding of parser code, refer to appropriate RFCs for proper specs
+- all words are network order
+
+www.google.com A request:
+
+0, 2: random transaction ID
+2, 2: flags: only the "recursion desired" bit set. (bit 8 of word)
+4, 2: questions: 1
+6, 2: answer RR's: 0.
+8, 2: authority RR's: 0.
+10, 2: additional RR's: 0.
+12, n: payload:
+  query:
+    #03 "www" #06 "google" #03 "com" #00
+    size-4, 2: type: host address (1)
+    size-2, 2: class: inet (1)
+
+reply:
+
+0,2: random transaction ID
+2,2: flags: set: response (bit 15), recursion desired (8), recursion available (7)
+4,4: questions: 1
+6,4: answer RR's: 2
+8,4: authority RR's: 9
+10,4: additional RR's: 9
+12: payload:
+  query:
+    ....
+  answer: CNAME
+    0,2 "c0 0c" "name: www.google.com"
+    2,2 "00 05" "type: cname for an alias"
+    4,2 "00 01" "class: inet"
+    6,4: TTL
+    10,2: data length "00 17" (23)
+    12: the cname name (www.google.akadns.net)
+  answer: A
+    0,2 ..
+    2,2 "00 01" host address
+    4,2 ...
+    6,4 ...
+    10,2: data length (4)
+    12,4: binary IP
+  authority - 9 records
+  additional - 9 records
+
+
+  ipv6 AAAA reply:
+    0,2: ...
+    2,2: type: 001c
+    4,2: class: inet (0001)
+    6,2: TTL
+    10,2: data size (16)
+    12,16: binary IP
+
+  ptr request: query type 000c
+
+name compression: word "cxxx" in the name, xxx points to offset in the packet}
+
+end.
diff --git a/dnssync.pas b/dnssync.pas
new file mode 100755
index 0000000..379aa05
--- /dev/null
+++ b/dnssync.pas
@@ -0,0 +1,262 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit dnssync;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+  uses
+    dnscore,
+    binipstuff,
+    {$ifdef win32}
+      winsock,
+      windows,
+    {$else}
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,unixutil,
+      {$endif}
+      sockets,
+      fd_utils,
+    {$endif}
+    sysutils;
+
+//convert a name to an IP
+//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support
+//compiled in)
+//on error the binip will have a family of 0 (other fiels are also currently
+//zeroed out but may be used for further error information in future)
+//timeout is in seconds, it is ignored when using windows dns
+function forwardlookup(name:string;timeout:integer):tbinip;
+
+
+//convert an IP to a name, on error a null string will be returned, other 
+//details as above
+function reverselookup(ip:tbinip;timeout:integer):string;
+
+
+var
+  dnssyncserver:string;
+  id : integer;
+  {$ifdef win32}
+    sendquerytime : integer;
+  {$else}
+    sendquerytime : ttimeval;
+  {$endif}
+implementation
+{$ifdef win32}
+  uses dnswin;
+{$endif}
+
+{$i unixstuff.inc}
+{$i ltimevalstuff.inc}
+
+var
+  fd:integer;
+  state:tdnsstate;
+{$ifdef win32}
+  const
+    winsocket = 'wsock32.dll';
+  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
+  function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';
+  type
+    fdset=tfdset;
+{$endif}
+
+function sendquery(const packet:tdnspacket;len:integer):boolean;
+var
+  a:integer;
+  addr       : string;
+  port       : string;
+  inaddr     : TInetSockAddr;
+
+begin
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+  result := false;
+  if len = 0 then exit; {no packet}
+
+  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
+  port := '53';
+
+  inAddr.family:=AF_INET;
+  inAddr.port:=htons(strtointdef(port,0));
+  inAddr.addr:=htonl(longip(addr));
+
+  sendto(fd,packet,len,0,inaddr,sizeof(inaddr));
+  {$ifdef win32}
+    sendquerytime := GetTickCount and $3fff;
+  {$else}
+    gettimeofday(sendquerytime);
+  {$endif}
+  result := true;
+end;
+
+procedure setupsocket;
+var
+  inAddrtemp : TInetSockAddr;
+begin
+  if fd > 0 then exit;
+
+  fd := Socket(AF_INET,SOCK_DGRAM,0);
+  inAddrtemp.family:=AF_INET;
+  inAddrtemp.port:=0;
+  inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}
+  If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin
+    {$ifdef win32}
+      raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
+    {$else}
+      raise Exception.create('unable to bind '+inttostr(socketError));
+    {$endif}
+  end;
+end;
+
+procedure resolveloop(timeout:integer);
+var
+  selectresult   : integer;
+  fds            : fdset;
+  {$ifdef win32}
+    endtime      : longint;
+    starttime    : longint;
+    wrapmode     : boolean;
+    currenttime  : integer;
+  {$else}
+    endtime      : ttimeval;
+    currenttime    : ttimeval;
+
+  {$endif}
+  lag            : ttimeval;
+  currenttimeout : ttimeval;
+  selecttimeout	 : ttimeval;
+
+
+begin
+  {$ifdef win32}
+    starttime := GetTickCount and $3fff;
+    endtime := starttime +(timeout*1000);
+    if (endtime and $4000)=0 then begin
+      wrapmode := false;
+    end else begin
+      wrapmode := true;
+    end;
+    endtime := endtime and $3fff;
+  {$else}
+    gettimeofday(endtime);
+    endtime.tv_sec := endtime.tv_sec + timeout;
+  {$endif}
+
+  setupsocket;
+  repeat
+    state_process(state);
+    case state.resultaction of
+      action_ignore: begin
+{        writeln('ignore');}
+        {do nothing}
+      end;
+      action_done: begin
+{        writeln('done');}
+        exit;
+        //onrequestdone(self,0);
+      end;
+      action_sendquery:begin
+{        writeln('send query');}
+        sendquery(state.sendpacket,state.sendpacketlen);
+      end;
+    end;
+    {$ifdef win32}
+      currenttime := GetTickCount and $3fff;
+      msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);
+    {$else}
+      gettimeofday(currenttime);
+      selecttimeout := endtime;
+      tv_substract(selecttimeout,currenttime);
+    {$endif}
+    fd_zero(fds);
+    fd_set(fd,fds);
+    if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
+      selecttimeout.tv_sec := 0;
+      selecttimeout.tv_usec := retryafter;
+    end;
+    selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);
+    if selectresult > 0 then begin
+{      writeln('selectresult>0');}
+      //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
+      fillchar(state.recvpacket,sizeof(state.recvpacket),0);
+      {$ifdef win32}
+        msectotimeval(lag,(currenttime-sendquerytime)and$3fff);
+      {$else}
+        lag := currenttime;
+        tv_substract(lag,sendquerytime);
+
+      {$endif}
+
+      reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
+      state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);
+      state.parsepacket := true;
+    end;
+    if selectresult < 0 then exit;
+    if selectresult = 0 then begin
+      {$ifdef win32}
+        currenttime := GetTickCount;
+      {$else}
+        gettimeofday(currenttime);
+      {$endif}
+      reportlag(id,-1);
+      if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin
+        exit;
+      end else begin
+        //resend
+        sendquery(state.sendpacket,state.sendpacketlen);
+      end;
+    end;
+  until false;
+end;
+
+function forwardlookup(name:string;timeout:integer):tbinip;
+var
+  dummy : integer;
+begin
+  ipstrtobin(name,result);
+  if result.family <> 0 then exit; //it was an IP address, no need for dns
+                                   //lookup
+  {$ifdef win32}
+    if usewindns then begin
+      result := winforwardlookup(name,false,dummy);
+      exit;
+    end;
+  {$endif}
+  setstate_forward(name,state,0);
+  resolveloop(timeout);
+  result := state.resultbin;
+end;
+
+function reverselookup(ip:tbinip;timeout:integer):string;
+var
+  dummy : integer;
+begin
+  {$ifdef win32}
+    if usewindns then begin
+      result := winreverselookup(ip,dummy);
+      exit;
+    end;
+  {$endif}
+  setstate_reverse(ip,state);
+  resolveloop(timeout);
+  result := state.resultstr;
+end;
+
+{$ifdef win32}
+  var
+    wsadata : twsadata;
+
+  initialization
+    WSAStartUp($2,wsadata);
+  finalization
+    WSACleanUp;
+{$endif}
+end.
+
+
diff --git a/dnswin.pas b/dnswin.pas
new file mode 100755
index 0000000..7d986d1
--- /dev/null
+++ b/dnswin.pas
@@ -0,0 +1,332 @@
+unit dnswin;
+
+interface
+uses binipstuff,classes,lcore;
+
+//on failure a null string or zeroed out binip will be retuned and error will be
+//set to a windows error code (error will be left untouched under non error
+//conditions).
+function winforwardlookup(name : string;ipv6preffered : boolean;var error:integer) : tbinip;
+function winreverselookup(ip:tbinip;var error:integer):string;
+
+
+type
+  //do not call destroy on a tdnswinasync instead call release and the
+  //dnswinasync will be freed when appropriate. Calling destroy will block
+  //the calling thread until the dns lookup completes.
+  //release should only be called from the main thread
+  tdnswinasync=class(tthread)
+  private
+    ipv6preffered : boolean;
+    freverse : boolean;
+    error : integer;
+    freewhendone : boolean;
+    hadevent : boolean;
+  protected
+    procedure execute; override;
+  public
+    onrequestdone:tsocketevent;
+    name : string;
+    ip : tbinip;
+
+    procedure forwardlookup(name:string;ipv6preffered:boolean);
+    procedure reverselookup(ip:tbinip);
+    destructor destroy; override;
+    procedure release;
+    constructor create;
+    property reverse : boolean read freverse;
+
+  end;
+
+implementation
+uses
+  lsocket,pgtypes,sysutils,winsock,windows,messages;
+
+type
+  //taddrinfo = record; //forward declaration
+  paddrinfo = ^taddrinfo;
+  taddrinfo = packed record
+    ai_flags : longint;
+    ai_family : longint;
+    ai_socktype : longint;
+    ai_protocol : longint;
+    ai_addrlen : taddrint;
+    ai_canonname : pchar;
+    ai_addr : pinetsockaddrv;
+    ai_next : paddrinfo;
+  end;
+  ppaddrinfo = ^paddrinfo;
+  tgetaddrinfo = function(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+  tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;
+  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+var
+  getaddrinfo : tgetaddrinfo;
+  freeaddrinfo : tfreeaddrinfo;
+  getnameinfo : tgetnameinfo;
+procedure v4onlyfreeaddrinfo(ai : paddrinfo); stdcall;
+begin
+  freemem(ai.ai_addr);
+  freemem(ai);
+end;
+
+type
+  plongint = ^longint;
+  pplongint = ^plongint;
+
+function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+var
+  output : paddrinfo;
+  hostent : phostent;
+begin
+  if hints.ai_family = af_inet then begin
+    result := 0;
+    getmem(output,sizeof(taddrinfo));
+    getmem(output.ai_addr,sizeof(tinetsockaddr));
+    output.ai_addr.InAddr.family := af_inet;
+    if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0;
+    hostent := gethostbyname(nodename);
+    if hostent = nil then begin
+      result := wsagetlasterror;
+      v4onlyfreeaddrinfo(output);
+      exit;
+    end;
+    output.ai_addr.InAddr.addr := pplongint(hostent.h_addr_list)^^;
+    output.ai_flags := 0;
+    output.ai_family := af_inet;
+    output.ai_socktype := 0;
+    output.ai_protocol := 0;
+    output.ai_addrlen := sizeof(tinetsockaddr);
+    output.ai_canonname := nil;
+    output.ai_next := nil;
+
+    res^ := output;
+  end else begin
+    result := WSANO_RECOVERY;
+  end;
+end;
+
+function min(a,b : integer):integer;
+begin
+  if a<b then result := a else result := b;
+end;
+
+function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+var
+  hostent : phostent;
+  bytestocopy : integer;
+begin
+  if sa.InAddr.family = af_inet then begin
+    result := 0;
+    hostent := gethostbyaddr(@(sa.inaddr.addr),4,AF_INET);
+    if hostent = nil then begin
+      result := wsagetlasterror;
+      exit;
+    end;
+    bytestocopy := min(strlen(hostent.h_name)+1,hostlen);
+    move((hostent.h_name)^,host^,bytestocopy);
+
+
+  end else begin
+    result := WSANO_RECOVERY;
+  end;
+end;
+
+
+procedure populateprocvars;
+var
+  libraryhandle : hmodule;
+  i : integer;
+  dllname : string;
+
+begin
+  if assigned(getaddrinfo) then exit; //procvars already populated
+  for i := 0 to 1 do begin
+    if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';
+    libraryhandle := LoadLibrary(pchar(dllname));
+    getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');
+    freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');
+    getnameinfo := getprocaddress(libraryhandle,'getnameinfo');
+    if assigned(getaddrinfo) and assigned(freeaddrinfo) and assigned(getnameinfo) then begin
+      //writeln('found getaddrinfo and freeaddrinfo in'+dllname);
+      exit; //success
+    end;
+
+  end;
+  //writeln('could not find getaddrinfo and freeaddrinfo, falling back to ipv4 only lookup');
+  getaddrinfo := v4onlygetaddrinfo;
+  freeaddrinfo := v4onlyfreeaddrinfo;
+  getnameinfo := v4onlygetnameinfo;
+end;
+
+
+function winforwardlookup(name : string;ipv6preffered : boolean;var error : integer) : tbinip;
+var
+  hints: taddrinfo;
+  res : paddrinfo;
+  pass : boolean;
+  ipv6 : boolean;
+  getaddrinforesult : integer;
+begin
+  populateprocvars;
+
+  for pass := false to true do begin
+    ipv6 := ipv6preffered xor pass;
+    hints.ai_flags := 0;
+    if ipv6 then begin
+      hints.ai_family := AF_INET6;
+    end else begin
+      hints.ai_family := AF_INET;
+    end;
+    hints.ai_socktype := 0;
+    hints.ai_protocol := 0;
+    hints.ai_addrlen := 0;
+    hints.ai_canonname := nil;
+    hints.ai_addr := nil;
+    hints.ai_next := nil;
+    getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);
+    if getaddrinforesult = 0 then begin
+      if res.ai_family = af_inet then begin
+        result.family := af_inet;
+        result.ip := res.ai_addr.InAddr.addr;
+      end else {$ifdef ipv6}if res.ai_family = af_inet6 then begin
+        result.family := af_inet6;
+        result.ip6 := res.ai_addr.InAddr6.sin6_addr;
+      end;{$endif};
+
+      freeaddrinfo(res);
+      exit;
+    end;
+  end;
+  if getaddrinforesult <> 0 then begin
+    fillchar(result,0,sizeof(result));
+    error := getaddrinforesult;
+  end;
+end;
+
+function winreverselookup(ip:tbinip;var error : integer):string;
+var
+  sa : tinetsockaddrv;
+  getnameinforesult : integer;
+begin
+
+  if ip.family = AF_INET then begin
+    sa.InAddr.family := AF_INET;
+    sa.InAddr.port := 1;
+    sa.InAddr.addr := ip.ip;
+  end else {$ifdef ipv6}if ip.family = AF_INET6 then begin
+    sa.InAddr6.sin6_family  := AF_INET6;
+    sa.InAddr6.sin6_port := 1;
+    sa.InAddr6.sin6_addr := ip.ip6;
+  end else{$endif} begin
+    raise exception.create('unrecognised address family');
+  end;
+  populateprocvars;
+  setlength(result,1025);
+  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);
+  if getnameinforesult <> 0 then begin
+    error := getnameinforesult;
+    result := '';
+    exit;
+  end;
+  if pos(#0,result) >= 0 then begin
+    setlength(result,pos(#0,result)-1);
+  end;
+end;
+
+var
+  hwnddnswin : hwnd;
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+  dwas : tdnswinasync;
+begin
+  if (ahwnd=hwnddnswin) and (aumsg=wm_user) then begin
+    Dwas := tdnswinasync(alparam);
+    if assigned (dwas.onrequestdone) then dwas.onrequestdone(dwas,awparam);
+    dwas.hadevent := true;
+    if dwas.freewhendone then dwas.free;
+  end else begin
+    //not passing unknown messages on to defwindowproc will cause window
+    //creation to fail! --plugwash
+    Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+end;
+
+procedure tdnswinasync.forwardlookup(name:string;ipv6preffered:boolean);
+begin
+  self.name := name;
+  self.ipv6preffered := ipv6preffered;
+  freverse := false;
+  resume;
+end;
+procedure tdnswinasync.reverselookup(ip:tbinip);
+begin
+  self.ip := ip;
+  freverse := true;
+  resume;
+end;
+procedure tdnswinasync.execute;
+var
+  error : integer;
+begin
+  error := 0;
+  if reverse then begin
+    name := winreverselookup(ip,error);
+  end else begin
+    ip := winforwardlookup(name,ipv6preffered,error);
+
+  end;
+
+  postmessage(hwnddnswin,wm_user,error,taddrint(self));
+end;
+
+destructor tdnswinasync.destroy; 
+begin
+  WaitFor;
+  inherited destroy;
+end;
+procedure tdnswinasync.release;
+begin
+  if hadevent then destroy else begin
+    onrequestdone := nil;
+    freewhendone := true;
+  end;
+end;
+
+constructor tdnswinasync.create;
+begin
+  inherited create(true);
+end;
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'dnswinClass');
+begin
+
+    if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create lcore handle, hinstance=',hinstance);
+  hwnddnswin := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+  //writeln('dnswin hwnd is ',hwnddnswin);
+  //writeln('last error is ',GetLastError);
+end.
diff --git a/fd_utils.pas b/fd_utils.pas
new file mode 100755
index 0000000..ea6e833
--- /dev/null
+++ b/fd_utils.pas
@@ -0,0 +1,74 @@
+// this file contains code copied from linux.pp in the free pascal rtl
+// i had to copy them because i use a different definition of fdset to them
+// the copyright block from the file in question is shown below
+{
+   $Id: fd_utils.pas,v 1.2 2004/08/19 23:12:09 plugwash Exp $
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 1999-2000 by Michael Van Canneyt,
+   BSD parts (c) 2000 by Marco van de Voort
+   members of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$ifdef fpc}
+  {$mode delphi}
+  {$inlining on}
+{$endif}
+unit fd_utils;
+interface
+
+type
+    FDSet= Array [0..255] of longint; {31}
+    PFDSet= ^FDSet;
+const
+    absoloutemaxs=(sizeof(fdset)*8)-1;
+
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+Procedure FD_Zero(var fds:fdSet);
+Procedure FD_Set(fd:longint;var fds:fdSet);
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+
+{$ifdef fpc}
+  {$ifndef ver1_0}
+    {$define useinline}
+  {$endif}
+{$endif}
+
+implementation  
+uses sysutils;
+Procedure FD_Clr(fd:longint;var fds:fdSet);{$ifdef useinline}inline;{$endif}
+{ Remove fd from the set of filedescriptors}
+begin
+  if (fd < 0) then raise exception.create('FD_Clr fd out of range: '+inttostr(fd));
+  fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
+end;
+
+Procedure FD_Zero(var fds:fdSet);
+{ Clear the set of filedescriptors }
+begin
+  FillChar(fds,sizeof(fdSet),0);
+end;
+
+Procedure FD_Set(fd:longint;var fds:fdSet);{$ifdef useinline}inline;{$endif}
+{ Add fd to the set of filedescriptors }
+begin
+  if (fd < 0) then raise exception.create('FD_set fd out of range: '+inttostr(fd));
+  fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
+end;
+
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;{$ifdef useinline}inline;{$endif}
+{ Test if fd is part of the set of filedescriptors }
+begin
+  if (fd < 0) then begin
+    result := false;
+    exit;
+  end;
+  FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
+end;
+end.
diff --git a/httpserver_20080306/bfifo.pas b/httpserver_20080306/bfifo.pas
new file mode 100755
index 0000000..55cc24a
--- /dev/null
+++ b/httpserver_20080306/bfifo.pas
@@ -0,0 +1,148 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit bfifo;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+
+uses blinklist,pgtypes;
+
+const
+  pagesize=1420;
+
+type
+  tfifo=class(tobject)
+  private
+    l:tlinklist;     {add to}
+    getl:tlinklist; {remove from}
+    ofs:integer;
+    getofs:integer;
+  public
+    size:integer;
+    procedure add(data:pointer;len:integer);
+    function get(var resultptr:pointer;len:integer):integer;
+    procedure del(len:integer);
+    constructor create;
+    destructor destroy; override;
+  end;
+
+
+implementation
+
+var
+  testcount:integer;
+
+{
+
+xx1..... add
+xxxxxxxx
+....2xxx delete
+
+1 ofs
+2 getofs
+
+}
+
+procedure tfifo.add;
+var
+  a:integer;
+  p:tlinklist;
+begin
+  if len <= 0 then exit;
+  inc(size,len);
+  while len > 0 do begin
+    p := l;
+    if ofs = pagesize then begin
+      p := tplinklist.create;
+      if getl = nil then getl := p;
+      getmem(tplinklist(p).p,pagesize);
+      inc(testcount);
+      linklistadd(l,p);
+      ofs := 0;
+    end;
+    a := pagesize - ofs;
+    if len < a then a := len;
+    move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);
+    inc(taddrint(data),a);
+    dec(len,a);
+    inc(ofs,a);
+  end;
+end;
+
+function tfifo.get;
+var
+  p:tlinklist;
+  a:integer;
+begin
+  if len > size then len := size;
+  if len <= 0 then begin
+    result := 0;
+    resultptr := nil;
+    exit;
+  end;
+  p := getl;
+  resultptr := pointer(taddrint(tplinklist(p).p)+getofs);
+  result := pagesize-getofs;
+  if result > len then result := len;
+end;
+
+procedure tfifo.del;
+var
+  a:integer;
+  p,p2:tlinklist;
+begin
+  if len <= 0 then exit;
+  p := getl;
+  if len > size then len := size;
+  dec(size,len);
+
+  if len = 0 then exit;
+
+  while len > 0 do begin
+    a := pagesize-getofs;
+    if a > len then a := len;
+    inc(getofs,a);
+    dec(len,a);
+    if getofs = pagesize then begin
+      p2 := p.prev;
+      freemem(tplinklist(p).p);
+      dec(testcount);
+      linklistdel(l,p);
+      p.destroy;
+      p := p2;
+      getl := p;
+      getofs := 0;
+    end;
+  end;
+
+  if size = 0 then begin
+    if assigned(l) then begin
+      p := l;
+      freemem(tplinklist(p).p);
+      dec(testcount);
+      linklistdel(l,p);
+      p.destroy;
+      getl := nil;
+    end;
+    ofs := pagesize;
+    getofs := 0;
+  end;
+end;
+
+constructor tfifo.create;
+begin
+  ofs := pagesize;
+  inherited create;
+end;
+
+destructor tfifo.destroy;
+begin
+  del(size);
+  inherited destroy;
+end;
+
+end.
diff --git a/httpserver_20080306/binipstuff.pas b/httpserver_20080306/binipstuff.pas
new file mode 100755
index 0000000..ebb9f9c
--- /dev/null
+++ b/httpserver_20080306/binipstuff.pas
@@ -0,0 +1,395 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit binipstuff;
+
+interface
+
+{$ifndef win32}
+{$ifdef ipv6}
+uses sockets;
+{$endif}
+{$endif}
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$ifdef cpu386}{$define i386}{$endif}
+{$ifdef i386}{$define ENDIAN_LITTLE}{$endif}
+
+{$include uint32.inc}
+
+const
+  hexchars:array[0..15] of char='0123456789abcdef';
+  AF_INET=2;
+  {$ifdef win32}
+    AF_INET6=23;
+  {$else}
+    AF_INET6=10;
+  {$endif}
+
+type
+  {$ifdef ipv6}
+    
+    {$ifdef win32}
+      {$define want_Tin6_addr}
+    {$endif}
+    {$ifdef ver1_0}
+      {$define want_Tin6_addr}
+    {$endif}
+    {$ifdef want_Tin6_addr}
+      Tin6_addr = packed record
+        case byte of
+          0: (u6_addr8  : array[0..15] of byte);
+          1: (u6_addr16 : array[0..7] of Word);
+          2: (u6_addr32 : array[0..3] of uint32);
+          3: (s6_addr8  : array[0..15] of shortint);
+          4: (s6_addr   : array[0..15] of shortint);
+          5: (s6_addr16 : array[0..7] of smallint);
+          6: (s6_addr32 : array[0..3] of LongInt);
+      end;
+    {$endif}
+  {$endif}
+
+  tbinip=record
+    family:integer;
+    {$ifdef ipv6}
+      case integer of
+        0: (ip:longint);
+        1: (ip6:tin6_addr);
+    {$else}
+      ip:longint;
+    {$endif}
+  end;
+
+  {$ifdef win32}
+    TInetSockAddr = packed Record
+      family:Word;
+      port  :Word;
+      addr  :uint32;
+      pad   :array [1..8] of byte;
+    end;
+    {$ifdef ipv6}
+
+      TInetSockAddr6 = packed record
+        sin6_family: word;
+        sin6_port: word;
+        sin6_flowinfo: uint32;
+        sin6_addr: tin6_addr;
+        sin6_scope_id: uint32;
+      end;
+    {$endif}
+  {$endif}
+
+function htons(w:word):word;
+function htonl(i:uint32):uint32;
+
+function ipstrtobin(const s:string;var binip:tbinip):boolean;
+function ipbintostr(const binip:tbinip):string;
+{$ifdef ipv6}
+function ip6bintostr(const bin:tin6_addr):string;
+function ip6strtobin(const s:string;var bin:tin6_addr):boolean;
+{$endif}
+
+function comparebinip(const ip1,ip2:tbinip):boolean;
+
+{deprecated}
+function longip(s:string):longint;
+
+procedure converttov4(var ip:tbinip);
+
+implementation
+
+uses sysutils;
+
+function htons(w:word):word;
+begin
+  {$ifdef ENDIAN_LITTLE}
+  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
+  {$else}
+  result := w;
+  {$endif}
+end;
+
+function htonl(i:uint32):uint32;
+begin
+  {$ifdef ENDIAN_LITTLE}
+  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
+  {$else}
+  result := i;
+  {$endif}
+end;
+
+{internal}
+{converts dotted v4 IP to longint. returns host endian order}
+function longip(s:string):longint;
+var
+  l:longint;
+  a,b:integer;
+function convertbyte(const s:string):integer;
+begin
+  result := strtointdef(s,-1);
+  if result < 0 then begin
+    result := -1;
+    exit;
+  end;
+  if result > 255 then begin
+    result := -1;
+    exit;
+  end;
+  {01 exception}
+  if (result <> 0) and (s[1] = '0') then begin
+    result := -1;
+    exit;
+  end;
+  {+1 exception}
+  if not (s[1] in ['0'..'9']) then begin
+    result := -1;
+    exit
+  end;
+end;
+
+begin
+  result := 0;
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := b shl 24;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 16;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 8;
+  s := copy(s,a+1,256);
+  b := convertbyte(copy(s,1,256));if (b < 0) then exit;
+  l := l or b;
+  result := l;
+end;
+
+
+function ipstrtobin(const s:string;var binip:tbinip):boolean;
+begin
+  binip.family := 0;
+  result := false;
+  {$ifdef ipv6}
+  if pos(':',s) <> 0 then begin
+    {try ipv6. use builtin routine}
+    result := ip6strtobin(s,binip.ip6);
+    if result then binip.family := AF_INET6;
+    exit;
+  end;
+  {$endif}
+
+  {try v4}
+  binip.ip := htonl(longip(s));
+  if (binip.ip <> 0) or (s = '0.0.0.0') then begin
+    result := true;
+    binip.family := AF_INET;
+    exit;
+  end;
+end;
+
+function ipbintostr(const binip:tbinip):string;
+var
+  a:integer;
+begin
+  result := '';
+  {$ifdef ipv6}
+  if binip.family = AF_INET6 then begin
+    result := ip6bintostr(binip.ip6);
+  end else
+  {$endif}
+  if binip.family = AF_INET then begin
+    a := htonl(binip.ip);
+    result := inttostr(a shr 24)+'.'+inttostr((a shr 16) and $ff)+'.'+inttostr((a shr 8) and $ff)+'.'+inttostr(a and $ff);
+  end;
+end;
+
+
+{------------------------------------------------------------------------------}
+
+{$ifdef ipv6}
+
+{
+IPv6 address binary to/from string conversion routines
+written by beware (steendijk at xs4all dot nl)
+
+- implementation does not depend on other ipv6 code such as the tin6_addr type,
+  the parameter can also be untyped.
+- it is host endian neutral - binary format is aways network order
+- it supports compression of zeroes
+- it supports ::ffff:192.168.12.34 style addresses
+- they are made to do the Right Thing, more efficient implementations are possible
+}
+
+{fpc has hostaddrtostr6 and strtohostaddr6 but the later isnt implemented yet}
+
+
+function ip6bintostr(const bin:tin6_addr):string;
+{base16 with lowercase output}
+function makehex(w:word):string;
+begin
+  result := '';
+  if w >= 4096 then result := result + hexchars[w shr 12];
+  if w >= 256 then result := result + hexchars[w shr 8 and $f];
+  if w >= 16 then result := result + hexchars[w shr 4 and $f];
+  result := result + hexchars[w and $f];
+end;
+
+var
+  a,b,c,addrlen:integer;
+  runbegin,runlength:integer;
+  bytes:array[0..15] of byte absolute bin;
+  words:array[0..7] of word;
+  dwords:array[0..3] of integer absolute words;
+begin
+  for a := 0 to 7 do begin
+    words[a] := bytes[a shl 1] shl 8 or bytes[a shl 1 or 1];
+  end;
+  if (dwords[0] = 0) and (dwords[1] = 0) and (words[4] = 0) and (words[5] = $ffff) then begin
+    {::ffff:/96 exception: v4 IP}
+    addrlen := 6;
+  end else begin
+    addrlen := 8;
+  end;
+  {find longest run of zeroes}
+  runbegin := 0;
+  runlength := 0;
+  for a := 0 to addrlen-1 do begin
+    if words[a] = 0 then begin
+      c := 0;
+      for b := a to addrlen-1 do if words[b] = 0 then begin
+        inc(c);
+      end else break;
+      if (c > runlength) then begin
+        runlength := c;
+        runbegin := a;
+      end;
+    end;
+  end;
+  result := '';
+  for a := 0 to runbegin-1 do begin
+    if (a <> 0) then result := result + ':';
+    result := result + makehex(words[a]);
+  end;
+  if runlength > 0 then result := result + '::';
+  c := runbegin+runlength;
+  for a := c to addrlen-1 do begin
+    if (a > c) then result := result + ':';
+    result := result + makehex(words[a]);
+  end;
+  if addrlen = 6 then begin
+    result := result + ':'+inttostr(bytes[12])+'.'+inttostr(bytes[13])+'.'+inttostr(bytes[14])+'.'+inttostr(bytes[15]);
+  end;
+end;
+
+function ip6strtobin(const s:string;var bin:tin6_addr):boolean;
+var
+  a,b:integer;
+  fields:array[0..7] of string;
+  fieldcount:integer;
+  emptyfield:integer;
+  wordcount:integer;
+  words:array[0..7] of word;
+  bytes:array[0..15] of byte absolute bin;
+begin
+  result := false;
+  for a := 0 to 7 do fields[a] := '';
+  fieldcount := 0;
+  for a := 1 to length(s) do begin
+    if s[a] = ':' then inc(fieldcount) else fields[fieldcount] := fields[fieldcount] + s[a];
+    if fieldcount > 7 then exit;
+  end;
+  if fieldcount < 2 then exit;
+
+  {find the empty field (compressed zeroes), not counting the first and last there may be at most 1}
+  emptyfield := -1;
+  for a := 1 to fieldcount-1 do begin
+    if fields[a] = '' then begin
+      if emptyfield = -1 then emptyfield := a else exit;
+    end;
+  end;
+
+  {check if last field is a valid v4 IP}
+  a := longip(fields[fieldcount]);
+  if (a <> 0) or (fields[fieldcount] = '0.0.0.0') then wordcount := 6 else wordcount := 8;
+  {0:1:2:3:4:5:6.6.6.6
+   0:1:2:3:4:5:6:7}
+  fillchar(words,sizeof(words),0);
+  if wordcount = 6 then begin
+    if fieldcount > 6 then exit;
+    words[6] := a shr 16;
+    words[7] := a and $ffff;
+  end;
+  if emptyfield = -1 then begin
+    {no run length: must be an exact number of fields}
+    if wordcount = 6 then begin
+      if fieldcount <> 6 then exit;
+      emptyfield := 5;
+    end else if wordcount = 8 then begin
+      if fieldcount <> 7 then exit;
+      emptyfield := 7;
+    end else exit;
+  end;
+  for a := 0 to emptyfield do begin
+    if fields[a] = '' then b := 0 else b := strtointdef('$'+fields[a],-1);
+    if (b < 0) or (b > $ffff) then exit;
+    words[a] := b;
+  end;
+  if wordcount = 6 then dec(fieldcount);
+  for a := wordcount-1 downto wordcount-(fieldcount-emptyfield) do begin
+    b := a+fieldcount-wordcount+1;
+    if fields[b] = '' then b := 0 else b := strtointdef('$'+fields[b],-1);
+    if (b < 0) or (b > $ffff) then exit;
+    words[a] := b;
+  end;
+  for a := 0 to 7 do begin
+    bytes[a shl 1] := words[a] shr 8;
+    bytes[a shl 1 or 1] := words[a] and $ff;
+  end;
+  result := true;
+end;
+{$endif}
+
+function comparebinip(const ip1,ip2:tbinip):boolean;
+begin
+  if (ip1.ip <> ip2.ip) then begin
+    result := false;
+    exit;
+  end;
+
+  {$ifdef ipv6}
+  if ip1.family = AF_INET6 then begin
+    if (ip1.ip6.s6_addr32[1] <> ip2.ip6.s6_addr32[1])
+    or (ip1.ip6.s6_addr32[2] <> ip2.ip6.s6_addr32[2])
+    or (ip1.ip6.s6_addr32[3] <> ip2.ip6.s6_addr32[3]) then begin
+      result := false;
+      exit;
+    end;
+  end;
+  {$endif}
+
+  result := (ip1.family = ip2.family);
+end;
+
+{converts a binary IP to v4 if it is a v6 IP in the v4 range}
+procedure converttov4(var ip:tbinip);
+begin
+  {$ifdef ipv6}
+  if ip.family = AF_INET6 then begin
+    if (ip.ip6.u6_addr32[0] = 0) and (ip.ip6.u6_addr32[1] = 0) and
+    (ip.ip6.u6_addr16[4] = 0) and (ip.ip6.u6_addr16[5] = $ffff) then begin
+      ip.family := AF_INET;
+      ip.ip := ip.ip6.s6_addr32[3];
+    end;
+  end;
+  {$endif}
+end;
+
+end.
diff --git a/httpserver_20080306/blinklist.pas b/httpserver_20080306/blinklist.pas
new file mode 100755
index 0000000..2079b75
--- /dev/null
+++ b/httpserver_20080306/blinklist.pas
@@ -0,0 +1,118 @@
+(*
+ *  beware IRC services, blinklist.pas
+ *  Copyright (C) 2002 Bas Steendijk
+ *
+ *  This program is free software; you can redistribute it and/or modify
+ *  it under the terms of the GNU General Public License as published by
+ *  the Free Software Foundation; either version 2 of the License, or
+ *  (at your option) any later version.
+ *
+ *  This program is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with this program; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+unit blinklist;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+
+interface
+
+type
+  tlinklist=class(tobject)
+    next:tlinklist;
+    prev:tlinklist;
+    constructor create;
+    destructor destroy; override;
+  end;
+
+  {linklist with 2 links}
+  tlinklist2=class(tlinklist)
+    next2:tlinklist2;
+    prev2:tlinklist2;
+  end;
+
+  {linklist with one pointer}
+  tplinklist=class(tlinklist)
+    p:pointer
+  end;
+
+  tstringlinklist=class(tlinklist)
+    s:string;
+  end;
+
+  tthing=class(tlinklist)
+    name:string;      {name/nick}
+    hashname:integer; {hash of name}
+  end;
+
+{
+adding new block to list (baseptr)
+}
+procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
+procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
+
+
+procedure linklist2add(var baseptr,newptr:tlinklist2);
+procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
+
+var
+  linklistdebug:integer;
+
+implementation
+
+procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
+var
+  p:tlinklist;
+begin
+  p := baseptr;
+  baseptr := newptr;
+  baseptr.prev := nil;
+  baseptr.next := p;
+  if p <> nil then p.prev := baseptr;
+end;
+
+procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
+begin
+  if item = baseptr then baseptr := item.next;
+  if item.prev <> nil then item.prev.next := item.next;
+  if item.next <> nil then item.next.prev := item.prev;
+end;
+
+procedure linklist2add(var baseptr,newptr:tlinklist2);
+var
+  p:tlinklist2;
+begin
+  p := baseptr;
+  baseptr := newptr;
+  baseptr.prev2 := nil;
+  baseptr.next2 := p;
+  if p <> nil then p.prev2 := baseptr;
+end;
+
+procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
+begin
+  if item = baseptr then baseptr := item.next2;
+  if item.prev2 <> nil then item.prev2.next2 := item.next2;
+  if item.next2 <> nil then item.next2.prev2 := item.prev2;
+end;
+
+constructor tlinklist.create;
+begin
+  inherited create;
+  inc(linklistdebug);
+end;
+
+destructor tlinklist.destroy;
+begin
+  dec(linklistdebug);
+  inherited destroy;
+end;
+
+end.
diff --git a/httpserver_20080306/bsearchtree.pas b/httpserver_20080306/bsearchtree.pas
new file mode 100755
index 0000000..ad61751
--- /dev/null
+++ b/httpserver_20080306/bsearchtree.pas
@@ -0,0 +1,101 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+  
+{actually a hashtable. it was a tree in earlier versions}
+
+unit bsearchtree;
+
+interface
+
+uses blinklist;
+
+const
+  hashtable_size=$4000;
+
+type
+  thashitem=class(tlinklist)
+    hash:integer;
+    s:string;
+    p:pointer;
+  end;
+  thashtable=array[0..hashtable_size-1] of thashitem;
+  phashtable=^thashtable;
+
+{adds "item" to the tree for name "s". the name must not exist (no checking done)}
+procedure addtree(t:phashtable;s:string;item:pointer);
+
+{removes name "s" from the tree. the name must exist (no checking done)}
+procedure deltree(t:phashtable;s:string);
+
+{returns the item pointer for s, or nil if not found}
+function findtree(t:phashtable;s:string):pointer;
+
+implementation
+
+function makehash(s:string):integer;
+const
+  shifter=6;
+var
+  a,b:integer;
+begin
+  result := 0;
+  b := length(s);
+  for a := 1 to b do begin
+    result := (result shl shifter) xor byte(s[a]);
+  end;
+  result := (result xor result shr 16) and (hashtable_size-1);
+end;
+
+procedure addtree(t:phashtable;s:string;item:pointer);
+var
+  hash:integer;
+  p:thashitem;
+begin
+  hash := makehash(s);
+  p := thashitem.create;
+  p.hash := hash;
+  p.s := s;
+  p.p := item;
+  linklistadd(tlinklist(t[hash]),tlinklist(p));
+end;
+
+procedure deltree(t:phashtable;s:string);
+var
+  p,p2:thashitem;
+  hash:integer;
+begin
+  hash := makehash(s);
+  p := t[hash];
+  p2 := nil;
+  while p <> nil do begin
+    if p.s = s then begin
+      p2 := p;
+      break;
+    end;
+    p := thashitem(p.next);
+  end;
+  linklistdel(tlinklist(t[hash]),tlinklist(p2));
+  p2.destroy;
+end;
+
+
+function findtree(t:phashtable;s:string):pointer;
+var
+  p:thashitem;
+  hash:integer;
+begin
+  result := nil;
+  hash := makehash(s);
+  p := t[hash];
+  while p <> nil do begin
+    if p.s = s then begin
+      result := p.p;
+      exit;
+    end;
+    p := thashitem(p.next);
+  end;
+end;
+
+end.
diff --git a/httpserver_20080306/btime.pas b/httpserver_20080306/btime.pas
new file mode 100755
index 0000000..127839e
--- /dev/null
+++ b/httpserver_20080306/btime.pas
@@ -0,0 +1,362 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+{
+this unit returns unix timestamp with seconds and microseconds (as float)
+works on windows/delphi, and on freepascal on unix.
+}
+
+unit btime;
+
+interface
+
+type
+  float=extended;
+
+var
+  timezone:integer;
+  timezonestr:string;
+  irctime,unixtime:integer;
+  tickcount:integer;
+  settimebias:integer;
+  qpcjump:float; {can be read out and reset for debug purpose}
+  performancecountfreq:extended;
+
+function irctimefloat:float;
+function irctimeint:integer;
+
+function unixtimefloat:float;
+function unixtimeint:integer;
+
+function wintimefloat:float;
+
+procedure settime(newtime:integer);
+procedure gettimezone;
+procedure timehandler;
+procedure init;
+
+function timestring(i:integer):string;
+function timestrshort(i:integer):string;
+
+function oletounixfloat(t:float):float;
+function oletounix(t:tdatetime):integer;
+function unixtoole(i:integer):tdatetime;
+
+var
+  timefloatbias:float;
+  lastunixtimefloat:float=0;
+
+implementation
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  {$ifdef UNIX}
+    {$ifdef VER1_0}
+      linux,
+    {$else}
+      baseunix,unix,unixutil, {needed for 2.0.2}
+    {$endif}
+  {$else}
+    windows,
+  {$endif}
+  sysutils;
+
+  {$include unixstuff.inc}
+
+
+const
+  daysdifference=25569;
+
+function oletounixfloat(t:float):float;
+begin
+  t := (t - daysdifference) * 86400;
+  result := t;
+end;
+
+function oletounix(t:tdatetime):integer;
+begin
+  result := trunc(oletounixfloat(t));
+end;
+
+function unixtoole(i:integer):tdatetime;
+begin
+  result := ((i)/86400)+daysdifference;
+end;
+
+{$ifdef unix}
+{-----------------------------------------*nix/freepascal code to read time }
+
+function unixtimefloat:float;
+var
+  tv:ttimeval;
+begin
+  gettimeofday(tv);
+  result := tv.tv_sec+(tv.tv_usec/1000000);
+end;
+
+function wintimefloat:extended;
+begin
+  result := unixtimefloat;
+end;
+
+function unixtimeint:integer;
+var
+  tv:ttimeval;
+begin
+  gettimeofday(tv);
+  result := tv.tv_sec;
+end;
+
+{$else} {delphi 3}
+{------------------------------ windows/delphi code to read time}
+
+{ free pascals tsystemtime is incomaptible with windows api calls
+ so we declare it ourselves - plugwash
+}
+{$ifdef fpc}
+type
+  TSystemTime = record
+     wYear: Word;
+     wMonth: Word;
+     wDayOfWeek: Word;
+     wDay: Word;
+     wHour: Word;
+     wMinute: Word;
+     wSecond: Word;
+     wMilliseconds: Word;
+  end;
+ {$endif}
+function Date_utc: extended;
+var
+  SystemTime: TSystemTime;
+begin
+  {$ifdef fpc}
+    GetsystemTime(@SystemTime);
+  {$else}
+    GetsystemTime(SystemTime);
+  {$endif}
+  with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);
+end;
+
+function Time_utc: extended;
+var
+  SystemTime: TSystemTime;
+begin
+  {$ifdef fpc}
+    GetsystemTime(@SystemTime);
+  {$else}
+    GetsystemTime(SystemTime);
+  {$endif}
+  with SystemTime do
+    Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+end;
+
+function Now_utc: extended;
+begin
+  Result := round(Date_utc) + Time_utc;
+end;
+
+const
+  highdwordconst=4294967296.0;
+
+function wintimefloat:extended;
+var
+  p:packed record
+    lowpart:longint;
+    highpart:longint
+  end;
+  p2:tlargeinteger absolute p;
+  e:extended;
+begin
+  if performancecountfreq = 0 then begin
+    QueryPerformancefrequency(p2);
+    e := p.lowpart;
+    if e < 0 then e := e + highdwordconst;
+    performancecountfreq := ((p.highpart*highdwordconst)+e);
+  end;
+  queryperformancecounter(p2);
+  e := p.lowpart;
+  if e < 0 then e := e + highdwordconst;
+  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
+end;
+
+var
+  classpriority,threadpriority:integer;
+
+procedure settc;
+var
+  hprocess,hthread:integer;
+begin
+  hProcess := GetCurrentProcess;
+  hThread := GetCurrentThread;
+
+  ClassPriority := GetPriorityClass(hProcess);
+  ThreadPriority := GetThreadPriority(hThread);
+
+  SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
+  SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
+end;
+
+procedure unsettc;
+var
+  hprocess,hthread:integer;
+begin
+  hProcess := GetCurrentProcess;
+  hThread := GetCurrentThread;
+
+  SetPriorityClass(hProcess, ClassPriority);
+  SetThreadPriority(hThread,  ThreadPriority);
+end;
+
+function unixtimefloat:float;
+var
+  f,g,h:float;
+begin
+  if timefloatbias = 0 then begin
+    settc;
+    f := now_utc;
+    repeat g := now_utc; h := wintimefloat until g > f;
+    timefloatbias := oletounixfloat(g)-h;
+    unsettc;
+  end;
+  result := wintimefloat+timefloatbias;
+
+  {
+  workaround for QPC jumps
+  (approach 2: always check "hi res" QPC unixtime against the "guaranteed" systemtime one)
+  }
+  f := result-(oletounixfloat(now_utc));
+  if abs(f) > 0.02 then begin
+    f := timefloatbias;
+    timefloatbias := 0;
+    result := unixtimefloat;
+    qpcjump := qpcjump + f - timefloatbias;
+  end;
+
+  if (result <= lastunixtimefloat) then result := lastunixtimefloat + 0.0000001;
+  lastunixtimefloat := result;
+end;
+
+function unixtimeint:integer;
+begin
+  result := trunc(unixtimefloat);
+end;
+
+{$endif}
+{-----------------------------------------------end of platform specific}
+
+function irctimefloat:float;
+begin
+  result := unixtimefloat+settimebias;
+end;
+
+function irctimeint:integer;
+begin
+  result := unixtimeint+settimebias;
+end;
+
+
+procedure settime(newtime:integer);
+var
+  a:integer;
+begin
+  a := irctimeint-settimebias;
+  if newtime = 0 then settimebias := 0 else settimebias := newtime-a;
+
+  irctime := irctimeint;
+end;
+
+procedure timehandler;
+begin
+  if unixtime = 0 then init;
+  unixtime := unixtimeint;
+  irctime := irctimeint;
+  if unixtime and 63 = 0 then begin
+    {update everything, apply timezone changes, clock changes, etc}
+    gettimezone;
+    timefloatbias := 0;
+    unixtime := unixtimeint;
+    irctime := irctimeint;
+  end;
+end;
+
+
+procedure gettimezone;
+var
+  {$ifdef UNIX}
+    {$ifndef ver1_9_4}
+      {$ifndef ver1_0}
+        {$define above194}
+      {$endif}
+    {$endif}
+    {$ifndef above194}
+      hh,mm,ss:word;
+    {$endif}
+  {$endif}
+  l:integer;
+begin
+  {$ifdef UNIX}
+    {$ifdef above194}
+      timezone := tzseconds;
+    {$else}
+      gettime(hh,mm,ss);
+      timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
+    {$endif}
+  {$else}
+  timezone := round((now-now_utc)*86400);
+  {$endif}
+
+  while timezone > 43200 do dec(timezone,86400);
+  while timezone < -43200 do inc(timezone,86400);
+
+  if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
+  l := abs(timezone) div 60;
+  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);
+end;
+
+function timestrshort(i:integer):string;
+const
+  weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');
+  month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+
+  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
+  inttostr(y);
+end;
+
+function timestring(i:integer):string;
+const
+  weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');
+  month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+
+  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
+  timezonestr;
+end;
+
+procedure init;
+begin
+  qpcjump := 0;
+  settimebias := 0;
+  gettimezone;
+  unixtime := unixtimeint;
+  irctime := irctimeint;
+end;
+
+end.
diff --git a/httpserver_20080306/dnsasync.pas b/httpserver_20080306/dnsasync.pas
new file mode 100755
index 0000000..682f95f
--- /dev/null
+++ b/httpserver_20080306/dnsasync.pas
@@ -0,0 +1,241 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+//FIXME: this code only ever seems to use one dns server for a request and does
+//not seem to have any form of retry code.
+
+unit dnsasync;
+
+interface
+
+uses
+  {$ifdef win32}
+    dnswin,
+  {$endif}
+  lsocket,lcore,
+  classes,binipstuff,dnscore,btime;
+
+
+type
+  //after completion or cancelation a dnswinasync may be reused
+  tdnsasync=class(tcomponent)
+
+  private
+    //made a load of stuff private that does not appear to be part of the main
+    //public interface. If you make any of it public again please consider the
+    //consequences when using windows dns. --plugwash.
+    sock:twsocket;
+
+    sockopen:boolean;
+
+
+    state:tdnsstate;
+
+    dnsserverid:integer;
+    startts:double;
+    {$ifdef win32}
+      dwas : tdnswinasync;
+    {$endif}
+
+
+    procedure asyncprocess;
+    procedure receivehandler(sender:tobject;error:word);
+    function sendquery(const packet:tdnspacket;len:integer):boolean;
+    {$ifdef win32}
+      procedure winrequestdone(sender:tobject;error:word);
+    {$endif}
+  public
+    onrequestdone:tsocketevent;
+
+    //addr and port allow the application to specify a dns server specifically
+    //for this dnsasync object. This is not a reccomended mode of operation
+    //because it limits the app to one dns server but is kept for compatibility
+    //and special uses.
+    addr,port:string;
+
+    //A family value of AF_INET6 will give only
+    //ipv6 results. Any other value will give ipv4 results in preference and ipv6
+    //results if ipv4 results are not available;
+    forwardfamily:integer;
+
+    procedure cancel;//cancel an outstanding dns request
+    function dnsresult:string; //get result of dnslookup as a string
+    procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
+    procedure forwardlookup(const name:string); //start forward lookup,
+                                                //preffering ipv4
+    procedure reverselookup(const binip:tbinip); //start reverse lookup
+
+    constructor create(aowner:tcomponent); override;
+    destructor destroy; override;
+
+  end;
+
+implementation
+
+uses sysutils;
+
+constructor tdnsasync.create;
+begin
+  inherited create(aowner);
+  dnsserverid := -1;
+  sock := twsocket.create(self);
+end;
+
+destructor tdnsasync.destroy;
+begin
+  if dnsserverid >= 0 then begin
+    reportlag(dnsserverid,-1);
+    dnsserverid := -1;
+  end;
+  sock.release;
+  setstate_request_init('',state);
+  inherited destroy;
+end;
+
+procedure tdnsasync.receivehandler;
+begin
+  if dnsserverid >= 0 then begin
+    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));
+    dnsserverid := -1;
+  end;
+{  writeln('received reply');}
+  fillchar(state.recvpacket,sizeof(state.recvpacket),0);
+  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));
+  state.parsepacket := true;
+  asyncprocess;
+end;
+
+function tdnsasync.sendquery;
+begin
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+  result := false;
+  if len = 0 then exit; {no packet}
+  if not sockopen then begin
+    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;
+    startts := unixtimefloat;
+    if port = '' then port := '53';
+    sock.port := port;
+    sock.Proto := 'udp';
+    sock.ondataavailable := receivehandler;
+    try
+      sock.connect;
+    except
+      on e:exception do begin
+        //writeln('exception '+e.message);
+        exit;
+      end;
+    end;
+    sockopen := true;
+  end;
+  sock.send(@packet,len);
+  result := true;
+end;
+
+procedure tdnsasync.asyncprocess;
+begin
+  state_process(state);
+  case state.resultaction of
+    action_ignore: begin {do nothing} end;
+    action_done: begin
+      onrequestdone(self,0);
+    end;
+    action_sendquery:begin
+      sendquery(state.sendpacket,state.sendpacketlen);
+    end;
+  end;
+end;
+
+procedure tdnsasync.forwardlookup;
+begin
+  {$ifdef win32}
+    if usewindns or (addr = '') then begin
+      dwas := tdnswinasync.create;
+      dwas.onrequestdone := winrequestdone;
+      if forwardfamily = AF_INET6 then begin
+        dwas.forwardlookup(name,true);
+      end else begin
+        dwas.forwardlookup(name,false);
+      end;
+    end;
+  {$endif}
+
+  ipstrtobin(name,state.resultbin);
+  if state.resultbin.family <> 0 then begin
+    onrequestdone(self,0);
+    exit;
+  end;
+
+
+  setstate_forward(name,state,forwardfamily);
+  asyncprocess;
+
+end;
+
+procedure tdnsasync.reverselookup;
+
+begin
+  {$ifdef win32}
+    if usewindns or (addr = '') then begin
+      dwas := tdnswinasync.create;
+      dwas.onrequestdone := winrequestdone;
+      dwas.reverselookup(binip);
+    end;
+  {$endif}
+
+  setstate_reverse(binip,state);
+  asyncprocess;
+end;
+
+function tdnsasync.dnsresult;
+begin
+  if state.resultstr <> '' then result := state.resultstr else begin
+    result := ipbintostr(state.resultbin);
+  end;
+end;
+
+procedure tdnsasync.dnsresultbin(var binip:tbinip);
+begin
+  move(state.resultbin,binip,sizeof(binip));
+end;
+
+procedure tdnsasync.cancel;
+begin
+  {$ifdef win32}
+    if assigned(dwas) then begin
+      dwas.release;
+      dwas := nil;
+    end else 
+  {$endif}
+  begin
+
+    if dnsserverid >= 0 then begin
+      reportlag(dnsserverid,-1);
+      dnsserverid := -1;
+    end;
+    if sockopen then begin
+      sock.close;
+      sockopen := false;
+    end;
+  end;
+  setstate_failure(state);
+  onrequestdone(self,0);
+end;
+
+{$ifdef win32}
+  procedure tdnsasync.winrequestdone(sender:tobject;error:word);
 
+  begin
+    if dwas.reverse then begin 
+      state.resultstr := dwas.name;
+    end else begin 
+      state.resultbin := dwas.ip;
+      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin
+        fillchar(state.resultbin,sizeof(tbinip),0);
+      end;
+    end;
+    dwas.release;
+    onrequestdone(self,error);
+  end;
+{$endif}
+end.
diff --git a/httpserver_20080306/dnscore.pas b/httpserver_20080306/dnscore.pas
new file mode 100755
index 0000000..bb4fab4
--- /dev/null
+++ b/httpserver_20080306/dnscore.pas
@@ -0,0 +1,728 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+{
+
+  code wanting to use this dns system should act as follows (note: app
+  developers will probablly want to use dnsasync or dnssync or write a similar
+  wrapper unit of thier own).
+
+  for normal lookups call setstate_forward or setstate_reverse to set up the
+  state, for more obscure lookups use setstate_request_init and fill in other
+  relavent state manually.
+
+  call state_process which will do processing on the information in the state
+  and return an action
+  action_ignore means that dnscore wants the code that calls it to go
+  back to waiting for packets
+  action_sendpacket means that dnscore wants the code that calls it to send
+  the packet in sendpacket/sendpacketlen and then start (or go back to) listening
+  for
+  action_done means the request has completed (either suceeded or failed)
+
+  callers should resend the last packet they tried to send if they have not
+  been asked to send a new packet for more than some timeout value they choose.
+
+  when a packet is received the application should put the packet in
+  recvbuf/recvbuflen , set state.parsepacket and call state_process again
+
+  once the app gets action_done it can determine sucess or failure in the
+  following ways.
+
+  on failure state.resultstr will be an empty string and state.resultbin will
+  be zeroed out (easilly detected by the fact that it will have a family of 0)
+
+  on success for a A or AAAA lookup state.resultstr will be an empty string
+  and state.resultbin will contain the result (note: AAAA lookups require IPV6
+  enabled).
+
+  if an A lookup fails and the code is built with ipv6 enabled then the code
+  will return any AAAA records with the same name. The reverse does not apply
+  so if an application preffers IPV6 but wants IPV4 results as well it must
+  check them seperately.
+
+  on success for any other type of lookup state.resultstr will be an empty
+
+  note the state contains ansistrings, setstate_init with a null name parameter
+  can be used to clean theese up if required.
+
+  callers may use setstate_failure to mark the state as failed themseleves
+  before passing it on to other code, for example this may be done in the event
+  of a timeout.
+}
+unit dnscore;
+
+
+
+{$ifdef fpc}{$mode delphi}{$endif}
+
+
+
+
+
+interface
+
+uses binipstuff,classes,pgtypes;
+
+var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
+//hint to users of this unit that they should use windows dns instead.
+//May be disabled by applications if desired. (e.g. if setting a custom
+//dnsserverlist).
+
+//note: this unit will not be able to self populate it's dns server list on
+//older versions of windows.
+
+const
+  maxnamelength=127;
+  maxnamefieldlen=63;
+  //note: when using action_ignore the dnscore code *must* preserve the contents of state.sendpacket to allow for retries
+  //note: action_ignore must not be used in response to the original request but there is no valid reason for doing this anyway
+  action_ignore=0;
+  action_done=1;
+  action_sendquery=2;
+  querytype_a=1;
+  querytype_cname=5;
+  querytype_aaaa=28;
+  querytype_ptr=12;
+  querytype_ns=2;
+  querytype_soa=6;
+  querytype_mx=15;
+
+  maxrecursion=10;
+  maxrrofakind=20;
+
+  retryafter=300000; //microseconds must be less than one second;
+  timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
+type
+  dvar=array[0..0] of byte;
+  pdvar=^dvar;
+  tdnspacket=packed record
+    id:word;
+    flags:word;
+    rrcount:array[0..3] of word;
+    payload:array[0..511-12] of byte;
+  end;
+
+
+
+  tdnsstate=record
+    id:word;
+    recursioncount:integer;
+    queryname:string;
+    requesttype:word;
+    parsepacket:boolean;
+    resultstr:string;
+    resultbin:tbinip;
+    resultaction:integer;
+    numrr1:array[0..3] of integer;
+    numrr2:integer;
+    rrdata:string;
+    sendpacketlen:integer;
+    sendpacket:tdnspacket;
+    recvpacketlen:integer;
+    recvpacket:tdnspacket;
+    forwardfamily:integer;
+  end;
+
+  trr=packed record
+    requesttypehi:byte;
+    requesttype:byte;
+    clas:word;
+    ttl:integer;
+    datalen:word;
+    data:array[0..511] of byte;
+  end;
+
+  trrpointer=packed record
+    p:pointer;
+    ofs:integer;
+    len:integer;
+    namelen:integer;
+  end;
+
+//commenting out functions from interface that do not have documented semantics
+//and probablly should not be called from outside this unit, reenable them
+//if you must but please document them at the same time --plugwash
+
+//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
+//function makereversename(const binip:tbinip):string;
+
+procedure setstate_request_init(const name:string;var state:tdnsstate);
+
+//set up state for a foward lookup. A family value of AF_INET6 will give only
+//ipv6 results. Any other value will give ipv4 results in preference and ipv6
+//results if ipv4 results are not available;
+procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+
+procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
+procedure setstate_failure(var state:tdnsstate);
+//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+
+
+procedure state_process(var state:tdnsstate);
+
+//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
+
+//presumablly this is exported to allow more secure random functions
+//to be substituted?
+var randomfunction:function:integer;
+
+
+procedure populatednsserverlist;
+procedure cleardnsservercache;
+
+var
+  dnsserverlist : tstringlist;
+//  currentdnsserverno : integer;
+
+function getcurrentsystemnameserver(var id:integer) :string;
+
+//var
+//  unixnameservercache:string;
+{ $endif}
+
+
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+var
+  failurereason:string;
+
+implementation
+
+uses
+  {$ifdef win32}
+    windows,
+  {$endif}
+
+  sysutils;
+
+function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
+var
+  a,b:integer;
+  s:string;
+  arr:array[0..sizeof(packet)-1] of byte absolute packet;
+begin
+ { writeln('buildrequest: name: ',name);}
+  result := 0;
+  fillchar(packet,sizeof(packet),0);
+  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);
+  packet.flags := htons($0100);
+  packet.rrcount[0] := htons($0001);
+
+
+  s := copy(name,1,maxnamelength);
+  if s = '' then exit;
+  if s[length(s)] <> '.' then s := s + '.';
+  b := 0;
+  {encode name}
+  if (s = '.') then begin
+    packet.payload[0] := 0;
+    result := 12+5;
+  end else begin
+    for a := 1 to length(s) do begin
+      if s[a] = '.' then begin
+        if b > maxnamefieldlen then exit;
+        if (b = 0) then exit;
+        packet.payload[a-b-1] := b;
+        b := 0;
+      end else begin
+        packet.payload[a] := byte(s[a]);
+        inc(b);
+      end;
+    end;
+    if b > maxnamefieldlen then exit;
+    packet.payload[length(s)-b] := b;
+    result := length(s) + 12+5;
+  end;
+
+  arr[result-1] := 1;
+  arr[result-3] := requesttype and $ff;
+  arr[result-4] := requesttype shr 8;
+end;
+
+function makereversename(const binip:tbinip):string;
+var
+  name:string;
+  a,b:integer;
+begin
+  name := '';
+  if binip.family = AF_INET then begin
+    b := htonl(binip.ip);
+    for a := 0 to 3 do begin
+      name := name + inttostr(b shr (a shl 3) and $ff)+'.';
+    end;
+    name := name + 'in-addr.arpa';
+  end else
+  {$ifdef ipv6}
+  if binip.family = AF_INET6 then begin
+    for a := 15 downto 0 do begin
+      b := binip.ip6.u6_addr8[a];
+      name := name + hexchars[b and $f]+'.'+hexchars[b shr 4]+'.';
+    end;
+    name := name + 'ip6.arpa';
+  end else
+  {$endif}
+  begin
+    {empty name}
+  end;
+  result := name;
+end;
+
+{
+decodes DNS format name to a string. does not includes the root dot.
+doesnt read beyond len.
+empty result + non null failurereason: failure
+empty result + null failurereason: internal use
+}
+function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
+var
+  arr:array[0..sizeof(packet)-1] of byte absolute packet;
+  s:string;
+  a,b:integer;
+begin
+  numread := 0;
+  repeat
+    if (start+numread < 0) or (start+numread >= len) then begin
+      result := '';
+      failurereason := 'decoding name: got out of range1';
+      exit;
+    end;
+    b := arr[start+numread];
+    if b >= $c0 then begin
+      {recursive sub call}
+      if recursion > 10 then begin
+        result := '';
+        failurereason := 'decoding name: max recursion';
+        exit;
+      end;
+      if ((start+numread+1) >= len) then begin
+        result := '';
+        failurereason := 'decoding name: got out of range3';
+        exit;
+      end;
+      a := ((b shl 8) or arr[start+numread+1]) and $3fff;
+      s := decodename(packet,len,a,recursion+1,a);
+      if (s = '') and (failurereason <> '') then begin
+        result := '';
+        exit;
+      end;
+      if result <> '' then result := result + '.';
+      result := result + s;
+      inc(numread,2);
+      exit;
+    end else if b < 64 then begin
+      if (numread <> 0) and (b <> 0) then result := result + '.';
+      for a := start+numread+1 to start+numread+b do begin
+        if (a >= len) then begin
+          result := '';
+          failurereason := 'decoding name: got out of range2';
+          exit;
+        end;
+        result := result + char(arr[a]);
+      end;
+      inc(numread,b+1);
+
+      if b = 0 then begin
+        if (result = '') and (recursion = 0) then result := '.';
+        exit; {reached end of name}
+      end;
+    end else begin
+      failurereason := 'decoding name: read invalid char';
+      result := '';
+      exit; {invalid}
+    end;
+  until false;
+end;
+
+{==============================================================================}
+
+procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
+var
+  a:integer;
+begin
+  state.resultaction := action_done;
+  state.resultstr := '';
+  case trr(rrp.p^).requesttype of
+    querytype_a: begin
+      if htons(trr(rrp.p^).datalen) <> 4 then exit;
+      move(trr(rrp.p^).data,state.resultbin.ip,4);
+      state.resultbin.family :=AF_INET;
+    end;
+    {$ifdef ipv6}
+    querytype_aaaa: begin
+      if htons(trr(rrp.p^).datalen) <> 16 then exit;
+      state.resultbin.family := AF_INET6;
+      move(trr(rrp.p^).data,state.resultbin.ip6,16);
+    end;
+    {$endif}
+  else
+    {other reply types (PTR, MX) return a hostname}
+    state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
+    fillchar(state.resultbin,sizeof(state.resultbin),0);
+  end;
+end;
+
+procedure setstate_request_init(const name:string;var state:tdnsstate);
+begin
+  {destroy things properly}
+  state.resultstr := '';
+  state.queryname := '';
+  state.rrdata := '';
+  fillchar(state,sizeof(state),0);
+  state.queryname := name;
+  state.parsepacket := false;
+end;
+
+procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
+begin
+  setstate_request_init(name,state);
+  state.forwardfamily := family;
+  {$ifdef ipv6}
+  if family = AF_INET6 then state.requesttype := querytype_aaaa else
+  {$endif}
+  state.requesttype := querytype_a;
+end;
+
+procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
+begin
+  setstate_request_init(makereversename(binip),state);
+  state.requesttype := querytype_ptr;
+end;
+
+procedure setstate_failure(var state:tdnsstate);
+begin
+  state.resultstr := '';
+  fillchar(state.resultbin,sizeof(state.resultbin),0);
+  state.resultaction := action_done;
+end;
+
+procedure state_process(var state:tdnsstate);
+label recursed;
+label failure;
+var
+  a,b,ofs:integer;
+  rrtemp:^trr;
+  rrptemp:^trrpointer;
+begin
+  if state.parsepacket then begin
+    if state.recvpacketlen < 12 then begin
+      failurereason := 'Undersized packet';
+      state.resultaction := action_ignore;
+      exit;
+    end;
+    if state.id <> state.recvpacket.id then begin
+      failurereason := 'ID mismatch';
+      state.resultaction := action_ignore;
+      exit;
+    end;
+    state.numrr2 := 0;
+    for a := 0 to 3 do begin
+      state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
+      if state.numrr1[a] > maxrrofakind then goto failure;
+      inc(state.numrr2,state.numrr1[a]);
+    end;
+
+    setlength(state.rrdata,state.numrr2*sizeof(trrpointer));
+
+    {- put all replies into a list}
+
+    ofs := 12;
+    {get all queries}
+    for a := 0 to state.numrr1[0]-1 do begin
+      if (ofs < 12) or (ofs > state.recvpacketlen-4) then goto failure;
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrptemp.p := @state.recvpacket.payload[ofs-12];
+      rrptemp.ofs := ofs;
+      decodename(state.recvpacket,state.recvpacketlen,ofs,0,b);
+      rrptemp.len := b + 4;
+      inc(ofs,rrptemp.len);
+    end;
+
+    for a := state.numrr1[0] to state.numrr2-1 do begin
+      if (ofs < 12) or (ofs > state.recvpacketlen-12) then goto failure;
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      if decodename(state.recvpacket,state.recvpacketlen,ofs,0,b) = '' then goto failure;
+      rrtemp := @state.recvpacket.payload[ofs-12+b]; {rrtemp points to values and result, after initial name}
+      rrptemp.p := rrtemp;
+      rrptemp.ofs := ofs; {ofs is start of RR before initial name from start of packet}
+      rrptemp.namelen := b;
+      b := htons(rrtemp.datalen);
+      rrptemp.len := b + 10 + rrptemp.namelen;
+      inc(ofs,rrptemp.len);
+    end;
+    if (ofs <> state.recvpacketlen) then begin
+      failurereason := 'ofs <> state.packetlen';
+      goto failure;
+    end;
+
+    {- check for items of the requested type in answer section, if so return success first}
+    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrtemp := rrptemp.p;
+      b := rrptemp.len;
+      if rrtemp.requesttype = state.requesttype then begin
+        setstate_return(rrptemp^,b,state);
+        exit;
+      end;
+    end;
+
+    {if no items of correct type found, follow first cname in answer section}
+    for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
+      rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+      rrtemp := rrptemp.p;
+      b := rrptemp.len;
+      if rrtemp.requesttype = querytype_cname then begin
+        state.queryname := decodename(state.recvpacket,state.recvpacketlen,rrptemp.ofs+12,0,b);
+        goto recursed;
+      end;
+    end;
+
+    {no cnames found, no items of correct type found}
+    if state.forwardfamily <> 0 then goto failure;
+{$ifdef ipv6}
+    if (state.requesttype = querytype_a) then begin
+      {v6 only: in case of forward, look for AAAA in alternative section}
+      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin
+        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
+        rrtemp := rrptemp.p;
+        b := rrptemp.len;
+        if rrtemp.requesttype = querytype_aaaa then begin
+          setstate_return(rrptemp^,b,state);
+          exit;
+        end;
+      end;
+      {no AAAA's found in alternative, do a recursive lookup for them}
+      state.requesttype := querytype_aaaa;
+      goto recursed;
+    end;
+{$endif}
+    goto failure;
+recursed:
+    {here it needs recursed lookup}
+    {if needing to follow a cname, change state to do so}
+    inc(state.recursioncount);
+    if state.recursioncount > maxrecursion then goto failure;
+  end;
+
+  {here, a name needs to be resolved}
+  if state.queryname = '' then begin
+    failurereason := 'empty query name';
+    goto failure;
+  end;
+
+  {do /ets/hosts lookup here}
+  state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
+  if state.sendpacketlen = 0 then begin
+    failurereason := 'building request packet failed';
+    goto failure;
+  end;
+  state.id := state.sendpacket.id;
+  state.resultaction := action_sendquery;
+
+  exit;
+failure:
+  setstate_failure(state);
+end;
+{$ifdef win32}
+  const
+    MAX_HOSTNAME_LEN = 132;
+    MAX_DOMAIN_NAME_LEN = 132;
+    MAX_SCOPE_ID_LEN = 260    ;
+    MAX_ADAPTER_NAME_LENGTH = 260;
+    MAX_ADAPTER_ADDRESS_LENGTH = 8;
+    MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
+    ERROR_BUFFER_OVERFLOW = 111;
+    MIB_IF_TYPE_ETHERNET = 6;
+    MIB_IF_TYPE_TOKENRING = 9;
+    MIB_IF_TYPE_FDDI = 15;
+    MIB_IF_TYPE_PPP = 23;
+    MIB_IF_TYPE_LOOPBACK = 24;
+    MIB_IF_TYPE_SLIP = 28;
+
+
+  type
+    tip_addr_string=packed record
+      Next :pointer;
+      IpAddress : array[0..15] of char;
+      ipmask    : array[0..15] of char;
+      context   : dword;
+    end;
+    pip_addr_string=^tip_addr_string;
+    tFIXED_INFO=packed record
+       HostName         : array[0..MAX_HOSTNAME_LEN-1] of char;
+       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of char;
+       currentdnsserver : pip_addr_string;
+       dnsserverlist    : tip_addr_string;
+       nodetype         : longint;
+       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of char;
+       enablerouting    : longbool;
+       enableproxy      : longbool;
+       enabledns        : longbool;
+    end;
+    pFIXED_INFO=^tFIXED_INFO;
+
+  var
+    iphlpapi : thandle;
+    getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
+{$endif}
+procedure populatednsserverlist;
+var
+  {$ifdef win32}
+    fixed_info : pfixed_info;
+    fixed_info_len : longint;
+    currentdnsserver : pip_addr_string;
+  {$else}
+    t:textfile;
+    s:string;
+    a:integer;
+  {$endif}
+begin
+  //result := '';
+  if assigned(dnsserverlist) then begin
+    dnsserverlist.clear;
+  end else begin
+    dnsserverlist := tstringlist.Create;
+  end;
+  {$ifdef win32}
+    if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
+    if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
+    fixed_info_len := 0;
+    if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
+    //fixed_info_len :=sizeof(tfixed_info);
+    getmem(fixed_info,fixed_info_len);
+    if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
+      freemem(fixed_info);
+      exit;
+    end;
+    currentdnsserver := @(fixed_info.dnsserverlist);
+    while assigned(currentdnsserver) do begin
+      dnsserverlist.Add(currentdnsserver.IpAddress);
+      currentdnsserver := currentdnsserver.next;
+    end;
+    freemem(fixed_info);
+  {$else}
+    filemode := 0;
+    assignfile(t,'/etc/resolv.conf');
+    {$i-}reset(t);{$i+}
+    if ioresult <> 0 then exit;
+
+    while not eof(t) do begin
+      readln(t,s);
+      if not (copy(s,1,10) = 'nameserver') then continue;
+      s := copy(s,11,500);
+      while s <> '' do begin
+        if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
+      end;
+      a := pos(' ',s);
+      if a <> 0 then s := copy(s,1,a-1);
+      a := pos(#9,s);
+      if a <> 0 then s := copy(s,1,a-1);
+      //result := s;
+      //if result <> '' then break;
+      dnsserverlist.Add(s);
+    end;
+    close(t);
+  {$endif}
+end;
+
+procedure cleardnsservercache;
+begin
+  if assigned(dnsserverlist) then begin
+    dnsserverlist.destroy;
+    dnsserverlist := nil;
+  end;
+end;
+
+function getcurrentsystemnameserver(var id:integer):string;
+var 
+  counter : integer;
+
+begin
+  if not assigned(dnsserverlist) then populatednsserverlist;
+  if dnsserverlist.count=0 then raise exception.create('no dns servers availible');
+  id := 0;
+  if dnsserverlist.count >1 then begin
+
+    for counter := 1 to dnsserverlist.count-1 do begin
+      if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;
+    end;
+  end;
+  result := dnsserverlist[id]
+end;
+
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+var
+  counter : integer;
+  temp : integer;
+begin
+  if (id < 0) or (id >= dnsserverlist.count) then exit;
+  if lag = -1 then lag := timeoutlag;
+  for counter := 0 to dnsserverlist.count-1 do begin
+    temp := taddrint(dnsserverlist.objects[counter]) *15;
+    if counter=id then temp := temp + lag;
+    dnsserverlist.objects[counter] := tobject(temp div 16);
+  end;
+
+end;
+
+{  quick and dirty description of dns packet structure to aid writing and
+   understanding of parser code, refer to appropriate RFCs for proper specs
+- all words are network order
+
+www.google.com A request:
+
+0, 2: random transaction ID
+2, 2: flags: only the "recursion desired" bit set. (bit 8 of word)
+4, 2: questions: 1
+6, 2: answer RR's: 0.
+8, 2: authority RR's: 0.
+10, 2: additional RR's: 0.
+12, n: payload:
+  query:
+    #03 "www" #06 "google" #03 "com" #00
+    size-4, 2: type: host address (1)
+    size-2, 2: class: inet (1)
+
+reply:
+
+0,2: random transaction ID
+2,2: flags: set: response (bit 15), recursion desired (8), recursion available (7)
+4,4: questions: 1
+6,4: answer RR's: 2
+8,4: authority RR's: 9
+10,4: additional RR's: 9
+12: payload:
+  query:
+    ....
+  answer: CNAME
+    0,2 "c0 0c" "name: www.google.com"
+    2,2 "00 05" "type: cname for an alias"
+    4,2 "00 01" "class: inet"
+    6,4: TTL
+    10,2: data length "00 17" (23)
+    12: the cname name (www.google.akadns.net)
+  answer: A
+    0,2 ..
+    2,2 "00 01" host address
+    4,2 ...
+    6,4 ...
+    10,2: data length (4)
+    12,4: binary IP
+  authority - 9 records
+  additional - 9 records
+
+
+  ipv6 AAAA reply:
+    0,2: ...
+    2,2: type: 001c
+    4,2: class: inet (0001)
+    6,2: TTL
+    10,2: data size (16)
+    12,16: binary IP
+
+  ptr request: query type 000c
+
+name compression: word "cxxx" in the name, xxx points to offset in the packet}
+
+end.
diff --git a/httpserver_20080306/dnssync.pas b/httpserver_20080306/dnssync.pas
new file mode 100755
index 0000000..c64d320
--- /dev/null
+++ b/httpserver_20080306/dnssync.pas
@@ -0,0 +1,262 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+unit dnssync;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+  uses
+    dnscore,
+    binipstuff,
+    {$ifdef win32}
+      winsock,
+      windows,
+    {$else}
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,
+      {$endif}
+      sockets,
+      fd_utils,
+    {$endif}
+    sysutils;
+
+//convert a name to an IP
+//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support
+//compiled in)
+//on error the binip will have a family of 0 (other fiels are also currently
+//zeroed out but may be used for further error information in future)
+//timeout is in seconds, it is ignored when using windows dns
+function forwardlookup(name:string;timeout:integer):tbinip;
+
+
+//convert an IP to a name, on error a null string will be returned, other 
+//details as above
+function reverselookup(ip:tbinip;timeout:integer):string;
+
+
+var
+  dnssyncserver:string;
+  id : integer;
+  {$ifdef win32}
+    sendquerytime : integer;
+  {$else}
+    sendquerytime : ttimeval;
+  {$endif}
+implementation
+{$ifdef win32}
+  uses dnswin;
+{$endif}
+
+{$i unixstuff.inc}
+{$i ltimevalstuff.inc}
+
+var
+  fd:integer;
+  state:tdnsstate;
+{$ifdef win32}
+  const
+    winsocket = 'wsock32.dll';
+  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
+  function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';
+  type
+    fdset=tfdset;
+{$endif}
+
+function sendquery(const packet:tdnspacket;len:integer):boolean;
+var
+  a:integer;
+  addr       : string;
+  port       : string;
+  inaddr     : TInetSockAddr;
+
+begin
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+  result := false;
+  if len = 0 then exit; {no packet}
+
+  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
+  port := '53';
+
+  inAddr.family:=AF_INET;
+  inAddr.port:=htons(strtointdef(port,0));
+  inAddr.addr:=htonl(longip(addr));
+
+  sendto(fd,packet,len,0,inaddr,sizeof(inaddr));
+  {$ifdef win32}
+    sendquerytime := GetTickCount and $3fff;
+  {$else}
+    gettimeofday(sendquerytime);
+  {$endif}
+  result := true;
+end;
+
+procedure setupsocket;
+var
+  inAddrtemp : TInetSockAddr;
+begin
+  if fd > 0 then exit;
+
+  fd := Socket(AF_INET,SOCK_DGRAM,0);
+  inAddrtemp.family:=AF_INET;
+  inAddrtemp.port:=0;
+  inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}
+  If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin
+    {$ifdef win32}
+      raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
+    {$else}
+      raise Exception.create('unable to bind '+inttostr(socketError));
+    {$endif}
+  end;
+end;
+
+procedure resolveloop(timeout:integer);
+var
+  selectresult   : integer;
+  fds            : fdset;
+  {$ifdef win32}
+    endtime      : longint;
+    starttime    : longint;
+    wrapmode     : boolean;
+    currenttime  : integer;
+  {$else}
+    endtime      : ttimeval;
+    currenttime    : ttimeval;
+
+  {$endif}
+  lag            : ttimeval;
+  currenttimeout : ttimeval;
+  selecttimeout	 : ttimeval;
+
+
+begin
+  {$ifdef win32}
+    starttime := GetTickCount and $3fff;
+    endtime := starttime +(timeout*1000);
+    if (endtime and $4000)=0 then begin
+      wrapmode := false;
+    end else begin
+      wrapmode := true;
+    end;
+    endtime := endtime and $3fff;
+  {$else}
+    gettimeofday(endtime);
+    endtime.tv_sec := endtime.tv_sec + timeout;
+  {$endif}
+
+  setupsocket;
+  repeat
+    state_process(state);
+    case state.resultaction of
+      action_ignore: begin
+{        writeln('ignore');}
+        {do nothing}
+      end;
+      action_done: begin
+{        writeln('done');}
+        exit;
+        //onrequestdone(self,0);
+      end;
+      action_sendquery:begin
+{        writeln('send query');}
+        sendquery(state.sendpacket,state.sendpacketlen);
+      end;
+    end;
+    {$ifdef win32}
+      currenttime := GetTickCount and $3fff;
+      msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);
+    {$else}
+      gettimeofday(currenttime);
+      selecttimeout := endtime;
+      tv_substract(selecttimeout,currenttime);
+    {$endif}
+    fd_zero(fds);
+    fd_set(fd,fds);
+    if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
+      selecttimeout.tv_sec := 0;
+      selecttimeout.tv_usec := retryafter;
+    end;
+    selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);
+    if selectresult > 0 then begin
+{      writeln('selectresult>0');}
+      //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
+      fillchar(state.recvpacket,sizeof(state.recvpacket),0);
+      {$ifdef win32}
+        msectotimeval(lag,(currenttime-sendquerytime)and$3fff);
+      {$else}
+        lag := currenttime;
+        tv_substract(lag,sendquerytime);
+
+      {$endif}
+
+      reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
+      state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);
+      state.parsepacket := true;
+    end;
+    if selectresult < 0 then exit;
+    if selectresult = 0 then begin
+      {$ifdef win32}
+        currenttime := GetTickCount;
+      {$else}
+        gettimeofday(currenttime);
+      {$endif}
+      reportlag(id,-1);
+      if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin
+        exit;
+      end else begin
+        //resend
+        sendquery(state.sendpacket,state.sendpacketlen);
+      end;
+    end;
+  until false;
+end;
+
+function forwardlookup(name:string;timeout:integer):tbinip;
+var
+  dummy : integer;
+begin
+  ipstrtobin(name,result);
+  if result.family <> 0 then exit; //it was an IP address, no need for dns
+                                   //lookup
+  {$ifdef win32}
+    if usewindns then begin
+      result := winforwardlookup(name,false,dummy);
+      exit;
+    end;
+  {$endif}
+  setstate_forward(name,state,0);
+  resolveloop(timeout);
+  result := state.resultbin;
+end;
+
+function reverselookup(ip:tbinip;timeout:integer):string;
+var
+  dummy : integer;
+begin
+  {$ifdef win32}
+    if usewindns then begin
+      result := winreverselookup(ip,dummy);
+      exit;
+    end;
+  {$endif}
+  setstate_reverse(ip,state);
+  resolveloop(timeout);
+  result := state.resultstr;
+end;
+
+{$ifdef win32}
+  var
+    wsadata : twsadata;
+
+  initialization
+    WSAStartUp($2,wsadata);
+  finalization
+    WSACleanUp;
+{$endif}
+end.
+
+
diff --git a/httpserver_20080306/dnswin.pas b/httpserver_20080306/dnswin.pas
new file mode 100755
index 0000000..bae0780
--- /dev/null
+++ b/httpserver_20080306/dnswin.pas
@@ -0,0 +1,332 @@
+unit dnswin;
+
+interface
+uses binipstuff,classes,lcore;
+
+//on failure a null string or zeroed out binip will be retuned and error will be
+//set to a windows error code (error will be left untouched under non error
+//conditions).
+function winforwardlookup(name : string;ipv6preffered : boolean;var error:integer) : tbinip;
+function winreverselookup(ip:tbinip;var error:integer):string;
+
+
+type
+  //do not call destroy on a tdnswinasync instead call release and the
+  //dnswinasync will be freed when appropriate. Calling destroy will block
+  //the calling thread until the dns lookup completes.
+  //release should only be called from the main thread
+  tdnswinasync=class(tthread)
+  private
+    ipv6preffered : boolean;
+    freverse : boolean;
+    error : integer;
+    freewhendone : boolean;
+    hadevent : boolean;
+  protected
+    procedure execute; override;
+  public
+    onrequestdone:tsocketevent;
+    name : string;
+    ip : tbinip;
+
+    procedure forwardlookup(name:string;ipv6preffered:boolean);
+    procedure reverselookup(ip:tbinip);
+    destructor destroy; override;
+    procedure release;
+    constructor create;
+    property reverse : boolean read freverse;
+
+  end;
+
+implementation
+uses
+  lsocket,pgtypes,sysutils,winsock,windows,messages;
+
+type
+  //taddrinfo = record; //forward declaration
+  paddrinfo = ^taddrinfo;
+  taddrinfo = packed record
+    ai_flags : longint;
+    ai_family : longint;
+    ai_socktype : longint;
+    ai_protocol : longint;
+    ai_addrlen : taddrint;
+    ai_canonname : pchar;
+    ai_addr : pinetsockaddrv;
+    ai_next : paddrinfo;
+  end;
+  ppaddrinfo = ^paddrinfo;
+  tgetaddrinfo = function(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+  tfreeaddrinfo = procedure(ai : paddrinfo); stdcall;
+  tgetnameinfo = function(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+var
+  getaddrinfo : tgetaddrinfo;
+  freeaddrinfo : tfreeaddrinfo;
+  getnameinfo : tgetnameinfo;
+procedure v4onlyfreeaddrinfo(ai : paddrinfo); stdcall;
+begin
+  freemem(ai.ai_addr);
+  freemem(ai);
+end;
+
+type
+  plongint = ^longint;
+  pplongint = ^plongint;
+
+function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
+var
+  output : paddrinfo;
+  hostent : phostent;
+begin
+  if hints.ai_family = af_inet then begin
+    result := 0;
+    getmem(output,sizeof(taddrinfo));
+    getmem(output.ai_addr,sizeof(tinetsockaddr));
+    output.ai_addr.InAddr.family := af_inet;
+    if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0;
+    hostent := gethostbyname(nodename);
+    if hostent = nil then begin
+      result := wsagetlasterror;
+      v4onlyfreeaddrinfo(output);
+      exit;
+    end;
+    output.ai_addr.InAddr.addr := pplongint(hostent.h_addr_list)^^;
+    output.ai_flags := 0;
+    output.ai_family := af_inet;
+    output.ai_socktype := 0;
+    output.ai_protocol := 0;
+    output.ai_addrlen := sizeof(tinetsockaddr);
+    output.ai_canonname := nil;
+    output.ai_next := nil;
+
+    res^ := output;
+  end else begin
+    result := WSANO_RECOVERY;
+  end;
+end;
+
+function min(a,b : integer):integer;
+begin
+  if a<b then result := a else result := b;
+end;
+
+function v4onlygetnameinfo(sa:Pinetsockaddrv;salen : longint; host:pchar;hostlen : longint;serv:pchar;servlen:longint;flags:longint) : longint;stdcall;
+var
+  hostent : phostent;
+  bytestocopy : integer;
+begin
+  if sa.InAddr.family = af_inet then begin
+    result := 0;
+    hostent := gethostbyaddr(@(sa.inaddr.addr),4,AF_INET);
+    if hostent = nil then begin
+      result := wsagetlasterror;
+      exit;
+    end;
+    bytestocopy := min(strlen(hostent.h_name)+1,hostlen);
+    move((hostent.h_name)^,host^,bytestocopy);
+
+
+  end else begin
+    result := WSANO_RECOVERY;
+  end;
+end;
+
+
+procedure populateprocvars;
+var
+  libraryhandle : hmodule;
+  i : integer;
+  dllname : string;
+
+begin
+  if assigned(getaddrinfo) then exit; //procvars already populated
+  for i := 0 to 1 do begin
+    if i=0 then dllname := 'Ws2_32.dll' else dllname := 'Wship6.dll';
+    libraryhandle := LoadLibrary(pchar(dllname));
+    getaddrinfo := getprocaddress(libraryhandle,'getaddrinfo');
+    freeaddrinfo := getprocaddress(libraryhandle,'freeaddrinfo');
+    getnameinfo := getprocaddress(libraryhandle,'getnameinfo');
+    if assigned(getaddrinfo) and assigned(freeaddrinfo) and assigned(getnameinfo) then begin
+      //writeln('found getaddrinfo and freeaddrinfo in'+dllname);
+      exit; //success
+    end;
+
+  end;
+  //writeln('could not find getaddrinfo and freeaddrinfo, falling back to ipv4 only lookup');
+  getaddrinfo := v4onlygetaddrinfo;
+  freeaddrinfo := v4onlyfreeaddrinfo;
+  getnameinfo := v4onlygetnameinfo;
+end;
+
+
+function winforwardlookup(name : string;ipv6preffered : boolean;var error : integer) : tbinip;
+var
+  hints: taddrinfo;
+  res : paddrinfo;
+  pass : boolean;
+  ipv6 : boolean;
+  getaddrinforesult : integer;
+begin
+  populateprocvars;
+
+  for pass := false to true do begin
+    ipv6 := ipv6preffered xor pass;
+    hints.ai_flags := 0;
+    if ipv6 then begin
+      hints.ai_family := AF_INET6;
+    end else begin
+      hints.ai_family := AF_INET;
+    end;
+    hints.ai_socktype := 0;
+    hints.ai_protocol := 0;
+    hints.ai_addrlen := 0;
+    hints.ai_canonname := nil;
+    hints.ai_addr := nil;
+    hints.ai_next := nil;
+    getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);
+    if getaddrinforesult = 0 then begin
+      if res.ai_family = af_inet then begin
+        result.family := af_inet;
+        result.ip := res.ai_addr.InAddr.addr;
+      end else if res.ai_family = af_inet6 then begin
+        result.family := af_inet6;
+        result.ip6 := res.ai_addr.InAddr6.sin6_addr;
+      end;
+
+      freeaddrinfo(res);
+      exit;
+    end;
+  end;
+  if getaddrinforesult <> 0 then begin
+    fillchar(result,0,sizeof(result));
+    error := getaddrinforesult;
+  end;
+end;
+
+function winreverselookup(ip:tbinip;var error : integer):string;
+var
+  sa : tinetsockaddrv;
+  getnameinforesult : integer;
+begin
+
+  if ip.family = AF_INET then begin
+    sa.InAddr.family := AF_INET;
+    sa.InAddr.port := 1;
+    sa.InAddr.addr := ip.ip;
+  end else if ip.family = AF_INET6 then begin
+    sa.InAddr6.sin6_family  := AF_INET6;
+    sa.InAddr6.sin6_port := 1;
+    sa.InAddr6.sin6_addr := ip.ip6;
+  end else begin
+    raise exception.create('unrecognised address family');
+  end;
+  populateprocvars;
+  setlength(result,1025);
+  getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);
+  if getnameinforesult <> 0 then begin
+    error := getnameinforesult;
+    result := '';
+    exit;
+  end;
+  if pos(#0,result) >= 0 then begin
+    setlength(result,pos(#0,result)-1);
+  end;
+end;
+
+var
+  hwnddnswin : hwnd;
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+  dwas : tdnswinasync;
+begin
+  if (ahwnd=hwnddnswin) and (aumsg=wm_user) then begin
+    Dwas := tdnswinasync(alparam);
+    dwas.hadevent := true;
+    if assigned (dwas.onrequestdone) then dwas.onrequestdone(dwas,awparam);
+    if dwas.freewhendone then dwas.free;
+  end else begin
+    //not passing unknown messages on to defwindowproc will cause window
+    //creation to fail! --plugwash
+    Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+end;
+
+procedure tdnswinasync.forwardlookup(name:string;ipv6preffered:boolean);
+begin
+  self.name := name;
+  self.ipv6preffered := ipv6preffered;
+  freverse := false;
+  resume;
+end;
+procedure tdnswinasync.reverselookup(ip:tbinip);
+begin
+  self.ip := ip;
+  freverse := true;
+  resume;
+end;
+procedure tdnswinasync.execute;
+var
+  error : integer;
+begin
+  error := 0;
+  if reverse then begin
+    name := winreverselookup(ip,error);
+  end else begin
+    ip := winforwardlookup(name,ipv6preffered,error);
+
+  end;
+
+  postmessage(hwnddnswin,wm_user,error,taddrint(self));
+end;
+
+destructor tdnswinasync.destroy; 
+begin
+  WaitFor;
+  inherited destroy;
+end;
+procedure tdnswinasync.release;
+begin
+  if hadevent then destroy else begin
+    onrequestdone := nil;
+    freewhendone := true;
+  end;
+end;
+
+constructor tdnswinasync.create;
+begin
+  inherited create(true);
+end;
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'dnswinClass');
+begin
+
+    if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create lcore handle, hinstance=',hinstance);
+  hwnddnswin := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+  //writeln('dnswin hwnd is ',hwnddnswin);
+  //writeln('last error is ',GetLastError);
+end.
diff --git a/httpserver_20080306/fd_utils.pas b/httpserver_20080306/fd_utils.pas
new file mode 100755
index 0000000..9ad93dd
--- /dev/null
+++ b/httpserver_20080306/fd_utils.pas
@@ -0,0 +1,69 @@
+// this file contains code copied from linux.pp in the free pascal rtl
+// i had to copy them because i use a different definition of fdset to them
+// the copyright block from the file in question is shown below
+{
+   $Id: fd_utils.pas,v 1.2 2004/08/19 23:12:09 plugwash Exp $
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 1999-2000 by Michael Van Canneyt,
+   BSD parts (c) 2000 by Marco van de Voort
+   members of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$ifdef fpc}
+  {$mode delphi}
+  {$inlining on}
+{$endif}
+unit fd_utils;
+interface
+
+type
+    FDSet= Array [0..255] of longint; {31}
+    PFDSet= ^FDSet;
+const
+    absoloutemaxs=(sizeof(fdset)*8)-1;
+
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+Procedure FD_Zero(var fds:fdSet);
+Procedure FD_Set(fd:longint;var fds:fdSet);
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+
+
+implementation  
+uses sysutils;
+Procedure FD_Clr(fd:longint;var fds:fdSet);{$ifdef fpc}inline;{$endif}
+{ Remove fd from the set of filedescriptors}
+begin
+  if (fd < 0) then raise exception.create('FD_Clr fd out of range: '+inttostr(fd));
+  fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
+end;
+
+Procedure FD_Zero(var fds:fdSet);
+{ Clear the set of filedescriptors }
+begin
+  FillChar(fds,sizeof(fdSet),0);
+end;
+
+Procedure FD_Set(fd:longint;var fds:fdSet);{$ifdef fpc}inline;{$endif}
+{ Add fd to the set of filedescriptors }
+begin
+  if (fd < 0) then raise exception.create('FD_set fd out of range: '+inttostr(fd));
+  fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
+end;
+
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;{$ifdef fpc}inline;{$endif}
+{ Test if fd is part of the set of filedescriptors }
+begin
+  if (fd < 0) then begin
+    result := false;
+    exit;
+  end;
+  FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
+end;
+end.
diff --git a/httpserver_20080306/lcore.pas b/httpserver_20080306/lcore.pas
new file mode 100755
index 0000000..51fbf78
--- /dev/null
+++ b/httpserver_20080306/lcore.pas
@@ -0,0 +1,889 @@
+{lsocket.pas}
+
+{io and timer code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+{note: you must use the @ in the last param to tltask.create not doing so will
+ compile without error but will cause an access violation -pg}
+
+//note: events after release are normal and are the apps responsibility to deal with safely
+
+unit lcore;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$ifdef win32}
+  {$define nosignal}
+{$endif}
+interface
+  uses
+    sysutils,
+    {$ifndef win32}
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,
+      {$endif}
+      fd_utils,
+    {$endif}
+    classes,pgtypes,bfifo;
+  procedure processtasks;
+
+
+
+
+
+
+
+  const
+    receivebufsize=1460;
+
+  type
+    {$ifdef ver1_0}
+      sigset= array[0..31] of longint;
+    {$endif}
+
+    ESocketException   = class(Exception);
+    TBgExceptionEvent  = procedure (Sender : TObject;
+                                  E : Exception;
+                                  var CanClose : Boolean) of object;
+
+    // note : tsocketstate is defined in the same way as it is in François PIETTE's twsocket
+    // however tlsocket currently only uses wsClosed wsConnecting wsconnected and wsListening
+    TSocketState       = (wsInvalidState,
+                        wsOpened,     wsBound,
+                        wsConnecting, wsConnected,
+                        wsAccepting,  wsListening,
+                        wsClosed);
+
+    TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay);
+    TWSocketOptions      = set of TWSocketOption;
+
+    TSocketevent     = procedure(Sender: TObject; Error: word) of object;
+    //Tdataavailevent  = procedure(data : string);
+    TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;
+
+    tlcomponent = class(tcomponent)
+    public
+      released:boolean;
+      procedure release; virtual;
+      destructor destroy; override;
+    end;
+
+    tlasio = class(tlcomponent)
+    public
+      state              : tsocketstate      ;
+      ComponentOptions   : TWSocketOptions;
+      fdhandlein         : Longint           ;  {file discriptor}
+      fdhandleout        : Longint           ;  {file discriptor}
+
+      onsessionclosed    : tsocketevent      ;
+      ondataAvailable    : tsocketevent      ;
+      onsessionAvailable : tsocketevent      ;
+
+      onsessionconnected : tsocketevent      ;
+      onsenddata         : tsenddata      ;
+      ondatasent         : tsocketevent      ;
+      //connected          : boolean         ;
+      nextasin           : tlasio            ;
+      prevasin           : tlasio            ;
+
+      recvq              : tfifo;
+      OnBgException      : TBgExceptionEvent ;
+      //connectread        : boolean           ;
+      sendq              : tfifo;
+      closehandles       : boolean           ;
+      writtenthiscycle   : boolean           ;
+      onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd
+      lasterror:integer;
+      destroying:boolean;
+      function receivestr:string; virtual;
+      procedure close;
+      procedure abort;
+      procedure internalclose(error:word); virtual;
+      constructor Create(AOwner: TComponent); override;
+
+      destructor destroy; override;
+      procedure fdcleanup;
+      procedure HandleBackGroundException(E: Exception);
+      procedure handlefdtrigger(readtrigger,writetrigger:boolean); virtual;
+      procedure dup(invalue:longint);
+
+      function sendflush : integer;
+      procedure sendstr(const str : string);virtual;
+      procedure putstringinsendbuffer(const newstring : string);
+      function send(data:pointer;len:integer):integer;virtual;
+      procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
+      procedure deletebuffereddata;
+
+      //procedure messageloop;
+      function Receive(Buf:Pointer;BufSize:integer):integer; virtual;
+      procedure flush;virtual;{$ifdef win32} abstract;{$endif}
+      procedure dodatasent(wparam,lparam:longint);
+      procedure doreceiveloop(wparam,lparam:longint);
+      procedure sinkdata(sender:tobject;error:word);
+
+      procedure release; override; {test -beware}
+
+      function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
+
+      procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif}
+      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
+      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
+    protected
+      procedure dupnowatch(invalue:longint);
+    end;
+    ttimerwrapperinterface=class(tlcomponent)
+    public
+      function createwrappedtimer : tobject;virtual;abstract;
+//      procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
+      procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);virtual;abstract;
+      procedure setenabled(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
+      procedure setinterval(wrappedtimer : tobject;newvalue : integer);virtual;abstract;
+    end;
+
+  var
+    timerwrapperinterface : ttimerwrapperinterface;
+  type
+    {$ifdef win32}
+      ttimeval = record
+        tv_sec : longint;
+        tv_usec : longint;
+      end;
+    {$endif}
+    tltimer=class(tlcomponent)
+    protected
+
+
+      wrappedtimer : tobject;
+
+
+//      finitialevent       : boolean           ;
+      fontimer            : tnotifyevent      ;
+      fenabled            : boolean           ;
+      finterval	          : integer	     ; {miliseconds, default 1000}
+      {$ifndef win32}
+        procedure resettimes;
+      {$endif}
+//      procedure setinitialevent(newvalue : boolean);
+      procedure setontimer(newvalue:tnotifyevent);
+      procedure setenabled(newvalue : boolean);
+      procedure setinterval(newvalue : integer);
+    public
+      //making theese public for now, this code should probablly be restructured later though
+      prevtimer          : tltimer           ;
+      nexttimer          : tltimer           ;
+      nextts	         : ttimeval          ;
+
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+//      property initialevent : boolean read finitialevent write setinitialevent;
+      property ontimer : tnotifyevent read fontimer write setontimer;
+      property enabled : boolean read fenabled write setenabled;
+      property interval	: integer read finterval write setinterval;
+
+    end;
+
+    ttaskevent=procedure(wparam,lparam:longint) of object;
+
+    tltask=class(tobject)
+    public
+      handler  : ttaskevent;
+      obj      : tobject;
+      wparam   : longint;
+      lparam   : longint;
+      nexttask : tltask;
+      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+    end;
+
+
+
+    teventcore=class
+    public
+      procedure processmessages; virtual;abstract;
+      procedure messageloop; virtual;abstract;
+      procedure exitmessageloop; virtual;abstract;
+      procedure setfdreverse(fd : integer;reverseto : tlasio);virtual;abstract;
+      procedure rmasterset(fd : integer;islistensocket : boolean);  virtual;abstract;
+      procedure rmasterclr(fd: integer);  virtual;abstract;
+      procedure wmasterset(fd : integer); virtual;abstract;
+      procedure wmasterclr(fd: integer);  virtual;abstract;
+    end;
+var
+    eventcore : teventcore;
+
+procedure processmessages;
+procedure messageloop;
+procedure exitmessageloop;
+
+var
+  firstasin                             : tlasio     ;
+  firsttimer                            : tltimer    ;
+  firsttask  , lasttask   , currenttask : tltask     ;
+
+  numread                               : integer    ;
+  mustrefreshfds                        : boolean    ;
+{  lcoretestcount:integer;}
+
+  asinreleaseflag:boolean;
+
+
+procedure disconnecttasks(aobj:tobject);
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+type
+  tonaddtask = procedure(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+var
+  onaddtask : tonaddtask;
+
+
+procedure sleep(i:integer);
+{$ifndef nosignal}
+  procedure prepsigpipe;inline;
+{$endif}
+
+
+implementation
+{$ifndef nosignal}
+  uses {sockets,}lloopback,lsignal;
+{$endif}
+{$ifdef win32}
+  uses windows;
+{$endif}
+{$ifndef win32}
+  {$include unixstuff.inc}
+{$endif}
+{$include ltimevalstuff.inc}
+
+
+{!!! added sleep call -beware}
+procedure sleep(i:integer);
+var
+  tv:ttimeval;
+begin
+  {$ifdef win32}
+    windows.sleep(i);
+  {$else}
+    tv.tv_sec := i div 1000;
+    tv.tv_usec := (i mod 1000) * 1000;
+    select(0,nil,nil,nil,@tv);
+  {$endif}
+end;
+
+destructor tlcomponent.destroy;
+begin
+  disconnecttasks(self);
+  inherited destroy;
+end;
+
+
+
+
+procedure tlcomponent.release;
+begin
+  released := true;
+end;
+
+procedure tlasio.release;
+begin
+  asinreleaseflag := true;
+  inherited release;
+end;
+
+procedure tlasio.doreceiveloop;
+begin
+  if recvq.size = 0 then exit;
+  if assigned(ondataavailable) then ondataavailable(self,0);
+  if not (wsonoreceiveloop in componentoptions) then
+  if recvq.size > 0 then tltask.create(self.doreceiveloop,self,0,0);
+end;
+
+function tlasio.receivestr;
+begin
+  setlength(result,recvq.size);
+  receive(@result[1],length(result));
+end;
+
+function tlasio.receive(Buf:Pointer;BufSize:integer):integer;
+var
+  i,a,b:integer;
+  p:pointer;
+begin
+  i := bufsize;
+  if recvq.size < i then i := recvq.size;
+  a := 0;
+  while (a < i) do begin
+    b := recvq.get(p,i-a);
+    move(p^,buf^,b);
+    inc(taddrint(buf),b);
+    recvq.del(b);
+    inc(a,b);
+  end;
+  result := i;
+  if wsonoreceiveloop in componentoptions then begin
+    if recvq.size = 0 then eventcore.rmasterset(fdhandlein,false);
+  end;
+end;
+
+constructor tlasio.create;
+begin
+  inherited create(AOwner);
+  sendq := tfifo.create;
+  recvq := tfifo.create;
+  state := wsclosed;
+  fdhandlein := -1;
+  fdhandleout := -1;
+  nextasin := firstasin;
+  prevasin := nil;
+  if assigned(nextasin) then nextasin.prevasin := self;
+  firstasin := self;
+
+  released := false;
+end;
+
+destructor tlasio.destroy;
+begin
+  destroying := true;
+  if state <> wsclosed then close;
+  if prevasin <> nil then begin
+    prevasin.nextasin := nextasin;
+  end else begin
+    firstasin := nextasin;
+  end;
+  if nextasin <> nil then begin
+    nextasin.prevasin := prevasin;
+  end;
+  recvq.destroy;
+  sendq.destroy;
+  inherited destroy;
+end;
+
+procedure tlasio.close;
+begin
+  internalclose(0);
+end;
+
+procedure tlasio.abort;
+begin
+  close;
+end;
+
+procedure tlasio.fdcleanup;
+begin
+  if fdhandlein <> -1 then begin
+    eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster)
+  end;
+  if fdhandleout <> -1 then begin
+    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster)
+  end;
+  if fdhandlein=fdhandleout then begin
+    if fdhandlein <> -1 then begin
+      myfdclose(fdhandlein);
+    end;
+  end else begin
+    if fdhandlein <> -1 then begin
+      myfdclose(fdhandlein);
+    end;
+    if fdhandleout <> -1 then begin
+      myfdclose(fdhandleout);
+    end;
+  end;
+  fdhandlein := -1;
+  fdhandleout := -1;
+end;
+
+procedure tlasio.internalclose(error:word);
+begin
+  if state<>wsclosed then begin
+    if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
+    eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
+    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+
+    if closehandles then begin
+      {$ifndef win32}
+        //anyone remember why this is here? --plugwash
+        fcntl(fdhandlein,F_SETFL,0);
+      {$endif}
+      myfdclose(fdhandlein);
+      if fdhandleout <> fdhandlein then begin
+        {$ifndef win32}
+          fcntl(fdhandleout,F_SETFL,0);
+        {$endif}
+        myfdclose(fdhandleout);
+      end;
+      eventcore.setfdreverse(fdhandlein,nil);
+      eventcore.setfdreverse(fdhandleout,nil);
+
+      fdhandlein := -1;
+      fdhandleout := -1;
+    end;
+    state := wsclosed;
+
+    if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error);
+  end;
+  sendq.del(maxlongint);
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+{ All exceptions *MUST* be handled. If an exception is not handled, the     }
+{ application will most likely be shut down !                               }
+procedure tlasio.HandleBackGroundException(E: Exception);
+var
+  CanAbort : Boolean;
+begin
+  CanAbort := TRUE;
+  { First call the error event handler, if any }
+  if Assigned(OnBgException) then begin
+    try
+      OnBgException(Self, E, CanAbort);
+    except
+    end;
+  end;
+  { Then abort the socket }
+  if CanAbort then begin
+    try
+      close;
+    except
+    end;
+  end;
+end;
+
+procedure tlasio.sendstr(const str : string);
+begin
+  putstringinsendbuffer(str);
+  sendflush;
+end;
+
+procedure tlasio.putstringinsendbuffer(const newstring : string);
+begin
+  if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
+end;
+
+function tlasio.send(data:pointer;len:integer):integer;
+begin
+  if state <> wsconnected then begin
+    result := -1;
+    exit;
+  end;
+  if len < 0 then len := 0;
+  result := len;
+  putdatainsendbuffer(data,len);
+  sendflush;
+end;
+
+
+procedure tlasio.putdatainsendbuffer(data:pointer;len:integer);
+begin
+  sendq.add(data,len);
+end;
+
+function tlasio.sendflush : integer;
+var
+  lensent : integer;
+  data:pointer;
+//  fdstestr : fdset;
+//  fdstestw : fdset;
+begin
+  if state <> wsconnected then exit;
+
+  lensent := sendq.get(data,2920);
+  if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
+
+  if result = -1 then lensent := 0 else lensent := result;
+
+  //sendq := copy(sendq,lensent+1,length(sendq)-lensent);
+  sendq.del(lensent);
+
+  //fd_clr(fdhandleout,fdsw); // this prevents the socket being closed by a write
+                            // that sends nothing because a previous socket has
+                            // slready flushed this socket when the message loop
+                            // reaches it
+//  if sendq.size > 0 then begin
+    eventcore.wmasterset(fdhandleout);//fd_set(fdhandleout,fdswmaster);
+//  end else begin
+//    wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+//  end;
+  if result > 0 then begin
+    if assigned(onsenddata) then onsenddata(self,result);
+//    if sendq.size=0 then if assigned(ondatasent) then begin
+//      tltask.create(self.dodatasent,self,0,0);
+//      //begin test code
+//      fd_zero(fdstestr);
+//      fd_zero(fdstestw);
+//      fd_set(fdhandlein,fdstestr);
+//      fd_set(fdhandleout,fdstestw);
+//      select(maxs,@fdstestr,@fdstestw,nil,0);
+//      writeln(fd_isset(fdhandlein,fdstestr),' ',fd_isset(fdhandleout,fdstestw));
+//      //end test code
+//    
+//    end;
+    writtenthiscycle := true;
+  end;
+end;
+
+procedure tlasio.dupnowatch(invalue:longint);
+begin
+  {  debugout('invalue='+inttostr(invalue));}
+  //readln;
+  if state<> wsclosed then close;
+  fdhandlein := invalue;
+  fdhandleout := invalue;
+  eventcore.setfdreverse(fdhandlein,self);
+  {$ifndef win32}
+    fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
+  {$endif}
+  state := wsconnected;
+
+end;
+
+
+procedure tlasio.dup(invalue:longint);
+begin
+  dupnowatch(invalue);
+  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
+  eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+end;
+
+
+procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
+var
+  sendflushresult : integer;
+  tempbuf:array[0..receivebufsize-1] of byte;
+begin
+  if (state=wsconnected) and writetrigger then begin
+    //writeln('write trigger');
+
+    if (sendq.size >0) then begin
+
+      sendflushresult := sendflush;
+      if (sendflushresult <= 0) and (not writtenthiscycle) then begin
+        if sendflushresult=0 then begin // linuxerror := 0;
+          internalclose(0);
+
+        end else begin
+          internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+        end;
+      end;
+
+    end else begin
+      //everything is sent fire off ondatasent event
+      if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+      if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0);
+    end;
+    if assigned(onfdwrite) then onfdwrite(self,0);
+  end;
+  writtenthiscycle := false;
+  if (state =wsconnected) and readtrigger then begin
+    if recvq.size=0 then begin
+      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
+      if (numread=0) and (not mustrefreshfds) then begin
+        {if i remember correctly numread=0 is caused by eof
+        if this isn't dealt with then you get a cpu eating infinite loop
+        however if onsessionconencted has called processmessages that could
+        cause us to drop to here with an empty recvq and nothing left to read
+        and we don't want that to cause the socket to close}
+
+        internalclose(0);
+      end else if (numread=-1) then begin
+        numread := 0;
+        internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+      end else if numread > 0 then recvq.add(@tempbuf,numread);
+    end;
+
+    if recvq.size > 0 then begin
+      if wsonoreceiveloop in componentoptions then eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster);
+      if assigned(ondataavailable) then ondataAvailable(self,0);
+      if not (wsonoreceiveloop in componentoptions) then if recvq.size > 0 then
+      tltask.create(self.doreceiveloop,self,0,0);
+    end;
+    //until (numread = 0) or (currentsocket.state<>wsconnected);
+{    debugout('inner loop complete');}
+  end;
+end;
+
+{$ifndef win32}
+  procedure tlasio.flush;
+  var
+    fds : fdset;
+  begin
+    fd_zero(fds);
+    fd_set(fdhandleout,fds);
+    while sendq.size>0 do begin
+      select(fdhandleout+1,nil,@fds,nil,nil);
+      if sendflush <= 0 then exit;
+    end;
+  end;
+{$endif}
+
+procedure tlasio.dodatasent(wparam,lparam:longint);
+begin
+  if assigned(ondatasent) then ondatasent(self,lparam);
+end;
+
+procedure tlasio.deletebuffereddata;
+begin
+  sendq.del(maxlongint);
+end;
+
+procedure tlasio.sinkdata(sender:tobject;error:word);
+begin
+  tlasio(sender).recvq.del(maxlongint);
+end;
+
+{$ifndef win32}
+  procedure tltimer.resettimes;
+  begin
+    gettimeofday(nextts);
+    {if not initialevent then} tv_add(nextts,interval);
+  end;
+{$endif}
+
+{procedure tltimer.setinitialevent(newvalue : boolean);
+begin
+  if newvalue <> finitialevent then begin
+    finitialevent := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setinitialevent(wrappedtimer,newvalue);
+    end else begin
+      resettimes;
+    end;
+  end;
+end;}
+
+procedure tltimer.setontimer(newvalue:tnotifyevent);
+begin
+  if @newvalue <> @fontimer then begin
+    fontimer := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setontimer(wrappedtimer,newvalue);
+    end else begin
+
+    end;
+  end;
+
+end;
+
+
+procedure tltimer.setenabled(newvalue : boolean);
+begin
+  if newvalue <> fenabled then begin
+    fenabled := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setenabled(wrappedtimer,newvalue);
+    end else begin
+      {$ifdef win32}
+        raise exception.create('non wrapper timers are not permitted on windows');
+      {$else}
+        resettimes;
+      {$endif}
+    end;
+  end;
+end;
+
+procedure tltimer.setinterval(newvalue:integer);
+begin
+  if newvalue <> finterval then begin
+    finterval := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setinterval(wrappedtimer,newvalue);
+    end else begin
+      {$ifdef win32}
+        raise exception.create('non wrapper timers are not permitted on windows');
+      {$else}
+        resettimes;
+      {$endif}
+    end;
+  end;
+
+end;
+
+
+
+
+constructor tltimer.create;
+begin
+  inherited create(AOwner);
+  if assigned(timerwrapperinterface) then begin
+    wrappedtimer := timerwrapperinterface.createwrappedtimer;
+  end else begin
+
+
+    nexttimer := firsttimer;
+    prevtimer := nil;
+
+    if assigned(nexttimer) then nexttimer.prevtimer := self;
+    firsttimer := self;
+  end;
+  interval := 1000;
+  enabled := true;
+  released := false;
+
+end;
+
+destructor tltimer.destroy;
+begin
+  if assigned(timerwrapperinterface) then begin
+    wrappedtimer.free;
+  end else begin
+    if prevtimer <> nil then begin
+      prevtimer.nexttimer := nexttimer;
+    end else begin
+      firsttimer := nexttimer;
+    end;
+    if nexttimer <> nil then begin
+      nexttimer.prevtimer := prevtimer;
+    end;
+    
+  end;
+  inherited destroy;
+end;
+
+constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  inherited create;
+  if assigned(onaddtask) then onaddtask(ahandler,aobj,awparam,alparam);
+  handler   := ahandler;
+  obj       := aobj;
+  wparam    := awparam;
+  lparam    := alparam;
+  {nexttask  := firsttask;
+  firsttask := self;}
+  if assigned(lasttask) then begin
+    lasttask.nexttask := self;
+  end else begin
+    firsttask := self;
+  end;
+  lasttask := self;
+  //ahandler(wparam,lparam);
+end;
+
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+
+  tltask.create(ahandler,aobj,awparam,alparam);
+end;
+
+
+
+
+{$ifndef nosignal}
+  procedure prepsigpipe;inline;
+  begin
+    starthandlesignal(sigpipe);
+    if not assigned(signalloopback) then begin
+      signalloopback := tlloopback.create(nil);
+      signalloopback.ondataAvailable := signalloopback.sinkdata;
+
+    end;
+
+  end;
+{$endif}
+
+procedure processtasks;//inline;
+var
+  temptask                : tltask   ;
+
+begin
+
+  if not assigned(currenttask) then begin
+    currenttask := firsttask;
+    firsttask := nil;
+    lasttask  := nil;
+  end;
+  while assigned(currenttask) do begin
+
+    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
+    if assigned(currenttask) then begin
+      temptask := currenttask;
+      currenttask := currenttask.nexttask;
+      temptask.free;
+    end;
+    //writeln('processed a task');
+  end;
+
+end;
+
+
+
+
+procedure disconnecttasks(aobj:tobject);
+var
+  currenttasklocal : tltask ;
+  counter          : byte   ;
+begin
+  for counter := 0 to 1 do begin
+    if counter = 0 then begin
+      currenttasklocal := firsttask; //main list of tasks
+    end else begin
+      currenttasklocal := currenttask; //needed in case called from a task
+    end;
+    // note i don't bother to sestroy the links here as that will happen when
+    // the list of tasks is processed anyway
+    while assigned(currenttasklocal) do begin
+      if currenttasklocal.obj = aobj then begin
+        currenttasklocal.obj := nil;
+        currenttasklocal.handler := nil;
+      end;
+      currenttasklocal := currenttasklocal.nexttask;
+    end;
+  end;
+end;
+
+
+procedure processmessages;
+begin
+  eventcore.processmessages;
+end;
+procedure messageloop;
+begin
+  eventcore.messageloop;
+end;
+
+procedure exitmessageloop;
+begin
+  eventcore.exitmessageloop;
+end;
+
+function tlasio.RealSend(Data : Pointer; Len : Integer) : Integer;
+begin
+  result := myfdwrite(fdhandleout,data^,len);
+  if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
+  eventcore.wmasterset(fdhandleout);
+end;
+{$ifndef win32}
+  procedure tlasio.myfdclose(fd : integer);
+  begin
+    fdclose(fd);
+  end;
+  function tlasio.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
+  begin
+    result := fdwrite(fd,buf,size);
+  end;
+
+  function tlasio.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
+  begin
+    result := fdread(fd,buf,size);
+  end;
+
+
+{$endif}
+
+
+begin
+  firstasin := nil;
+  firsttask := nil;
+  
+
+  {$ifndef nosignal}
+    signalloopback := nil;
+  {$endif}
+end.
+
+
+
+
+
diff --git a/httpserver_20080306/lcoregtklaz.pas b/httpserver_20080306/lcoregtklaz.pas
new file mode 100755
index 0000000..bbf4418
--- /dev/null
+++ b/httpserver_20080306/lcoregtklaz.pas
@@ -0,0 +1,142 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+      
+unit lcoregtklaz;
+{$mode delphi}
+interface
+	
+uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;
+//procedure lcoregtklazrun;
+const
+  G_IO_IN=1;
+  G_IO_OUT=4;
+  G_IO_PRI=2;
+  G_IO_ERR=8;
+
+  G_IO_HUP=16;
+  G_IO_NVAL=32;
+type
+  tlaztimerwrapperinterface=class(ttimerwrapperinterface)
+  public
+    function createwrappedtimer : tobject;override;
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;
+  end;
+
+procedure lcoregtklazinit;
+implementation
+  uses
+    ExtCtrls;
+{$I unixstuff.inc}
+var
+  giochannels : array[0..absoloutemaxs] of pgiochannel;
+
+function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;
+// return true if we want the callback to stay
+var
+  fd                    : integer ;
+  fdsrlocal , fdswlocal : fdset   ;
+  currentasio           : tlasio  ;
+begin
+  fd := g_io_channel_unix_get_fd(source);
+  fd_zero(fdsrlocal);
+  fd_set(fd,fdsrlocal);
+  fdswlocal := fdsrlocal;
+  select(fd+1,@fdsrlocal,@fdswlocal,nil,0);
+  if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin
+    currentasio := fdreverse[fd];
+    if assigned(currentasio) then begin
+      currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));
+    end else begin
+      rmasterclr(fd);
+      wmasterclr(fd);
+    end;
+  end;
+  case condition of
+    G_IO_IN : begin
+      result := rmasterisset(fd);
+    end;
+    G_IO_OUT : begin
+      result := wmasterisset(fd);
+    end;
+  end;
+end;
+
+procedure gtkrmasterset(fd : integer);
+begin
+  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
+  g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);
+end;
+
+procedure gtkrmasterclr(fd: integer);
+begin
+end;
+  
+procedure gtkwmasterset(fd : integer);
+begin
+  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
+  g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);
+end;
+
+procedure gtkwmasterclr(fd: integer);
+begin
+end;
+
+type
+  tsc = class
+    procedure dotasksandsink(sender:tobject;error:word);
+  end;
+var
+  taskloopback : tlloopback;
+  sc           : tsc;
+procedure tsc.dotasksandsink(sender:tobject;error:word);
+begin
+  with tlasio(sender) do begin
+    sinkdata(sender,error);
+    processtasks;
+  end;
+end;
+procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  taskloopback.sendstr(' ');
+  
+end;
+
+procedure lcoregtklazinit;
+begin
+  onrmasterset := gtkrmasterset;
+  onrmasterclr := gtkrmasterclr;
+  onwmasterset := gtkwmasterset;
+  onwmasterclr := gtkwmasterclr;
+  onaddtask := gtkaddtask;
+  taskloopback := tlloopback.create(nil);
+  taskloopback.ondataavailable := sc.dotasksandsink;
+  timerwrapperinterface := tlaztimerwrapperinterface.create(nil);
+end;
+
+function tlaztimerwrapperinterface.createwrappedtimer : tobject;
+begin
+  result := ttimer.create(nil);
+end;
+procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);
+begin
+  ttimer(wrappedtimer).ontimer := newvalue;
+end;
+procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);
+begin
+  ttimer(wrappedtimer).enabled := newvalue;
+end;
+
+
+procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);
+begin
+  ttimer(wrappedtimer).interval := newvalue;
+end;
+
+
+end.
+
diff --git a/httpserver_20080306/lcoreselect.pas b/httpserver_20080306/lcoreselect.pas
new file mode 100755
index 0000000..0369448
--- /dev/null
+++ b/httpserver_20080306/lcoreselect.pas
@@ -0,0 +1,391 @@
+{lsocket.pas}
+
+{io and timer code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+
+unit lcoreselect;
+
+
+interface
+uses
+  fd_utils;
+var
+  maxs                                  : longint    ;
+  exitloopflag                          : boolean    ; {if set by app, exit mainloop}
+
+function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
+function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
+
+implementation
+uses
+  lcore,sysutils,
+  {$ifdef VER1_0}
+    linux,
+  {$else}
+    baseunix,unix,
+  {$endif}
+  classes,pgtypes,bfifo,
+  {$ifndef nosignal}
+    lsignal;
+  {$endif}
+
+{$include unixstuff.inc}
+{$include ltimevalstuff.inc}
+var
+  fdreverse:array[0..absoloutemaxs] of tlasio;
+type
+  tselecteventcore=class(teventcore)
+    public
+      procedure processmessages; override;
+      procedure messageloop; override;
+      procedure exitmessageloop;override;
+      procedure setfdreverse(fd : integer;reverseto : tlasio); override;
+      procedure rmasterset(fd : integer;islistensocket : boolean); override;
+      procedure rmasterclr(fd: integer); override;
+      procedure wmasterset(fd : integer); override;
+      procedure wmasterclr(fd: integer); override;
+    end;
+
+procedure processtimers;inline;
+var
+  tv           ,tvnow     : ttimeval ;
+  currenttimer            : tltimer   ;
+  temptimer               : tltimer  ;
+
+begin
+  gettimeofday(tvnow);
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    //writeln(currenttimer.enabled);
+    if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
+      //if assigned(currenttimer.ontimer) then begin
+      //  if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
+      //  currenttimer.initialdone := true;
+      //end;
+      if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
+      currenttimer.nextts := timeval(tvnow);
+      tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
+    end;
+    temptimer := currenttimer;
+    currenttimer := currenttimer.nexttimer;
+    if temptimer.released then temptimer.free;
+  end;
+end;
+
+procedure processasios(var fdsr,fdsw:fdset);//inline;
+var
+  currentsocket : tlasio  ;
+  tempsocket    : tlasio  ;
+  socketcount   : integer ; // for debugging perposes :)
+  dw,bt:integer;
+begin
+{  inc(lcoretestcount);}
+
+    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
+    //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
+
+
+  {------- test optimised loop}
+  socketcount := 0;
+  for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
+    for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin
+      inc(socketcount);
+      currentsocket := fdreverse[dw shl 5 or bt];
+      {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
+      if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
+      {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
+      if not assigned(currentsocket) then begin
+        fdclose(dw shl 5 or bt);
+        continue
+      end;
+      if currentsocket.fdhandlein < 0 then begin
+        fdclose(dw shl 5 or bt);
+        continue
+      end;
+      try
+        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
+      except
+        on E: exception do begin
+          currentsocket.HandleBackGroundException(e);
+        end;
+      end;
+
+      if mustrefreshfds then begin
+        if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
+          fd_zero(fdsr);
+          fd_zero(fdsw);
+        end;
+      end;
+    end;
+  end;
+
+  if asinreleaseflag then begin
+    asinreleaseflag := false;
+    currentsocket := firstasin;
+    while assigned(currentsocket) do begin
+      tempsocket := currentsocket;
+      currentsocket := currentsocket.nextasin;
+      if tempsocket.released then begin
+        tempsocket.free;
+      end;
+    end;
+  end;
+  {
+  !!! issues:
+  - sockets which are released may not be freed because theyre never processed by the loop
+  made new code for handling this, using asinreleaseflag
+
+  - when/why does the mustrefreshfds select apply, sheck if i did it correctly?
+
+  - what happens if calling handlefdtrigger for a socket which does not have an event
+  }
+  {------- original loop}
+
+  (*
+  currentsocket := firstasin;
+  socketcount := 0;
+  while assigned(currentsocket) do begin
+    if mustrefreshfds then begin
+      if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
+        fd_zero(fdsr);
+        fd_zero(fdsw);
+      end;
+    end;
+    try
+      if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
+        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
+      end;
+    except
+      on E: exception do begin
+        currentsocket.HandleBackGroundException(e);
+      end;
+    end;
+    tempsocket := currentsocket;
+    currentsocket := currentsocket.nextasin;
+    inc(socketcount);
+    if tempsocket.released then begin
+      tempsocket.free;
+    end;
+  end; *)
+{  debugout('socketcount='+inttostr(socketcount));}
+end;
+
+procedure tselecteventcore.processmessages;
+var
+  fdsr         , fdsw : fdset   ;
+  selectresult        : longint ;
+begin
+  mustrefreshfds := false;
+  {$ifndef nosignal}
+    prepsigpipe;
+  {$endif}
+  selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
+  while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
+
+    processtasks;
+    processtimers;
+    if selectresult > 0 then begin
+      processasios(fdsr,fdsw);
+    end;
+    selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
+
+  end;
+  mustrefreshfds := true;
+end;
+
+
+var
+  FDSR , FDSW : fdset;
+
+Function  doSelect(timeOut:PTimeVal):longint;//inline;
+var
+  localtimeval : ttimeval;
+  maxslocal    : integer;
+begin
+  //unblock signals
+  //zeromemory(@sset,sizeof(sset));
+  //sset[0] := ;
+  fdsr := getfdsrmaster;
+  fdsw := getfdswmaster;
+
+  if assigned(firsttask) then begin
+    localtimeval.tv_sec  := 0;
+    localtimeval.tv_usec := 0;
+    timeout := @localtimeval;
+  end;
+
+  maxslocal := maxs;
+  mustrefreshfds := false;
+{  debugout('about to call select');}
+  {$ifndef nosignal}
+    sigprocmask(SIG_UNBLOCK,@blockset,nil);
+  {$endif}
+  result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
+  if result <= 0 then begin
+    fd_zero(FDSR);
+    fd_zero(FDSW);
+    if result=-1 then begin
+      if linuxerror = SYS_EINTR then begin
+        // we received a signal it's not a problem
+      end else begin
+        raise esocketexception.create('select returned error '+inttostr(linuxerror));
+      end;
+    end;
+  end;
+  {$ifndef nosignal}
+    sigprocmask(SIG_BLOCK,@blockset,nil);
+  {$endif}
+{  debugout('select complete');}
+end;
+
+procedure tselecteventcore.exitmessageloop;
+begin
+  exitloopflag := true
+end;
+
+
+
+procedure tselecteventcore.messageloop;
+var
+  tv           ,tvnow     : ttimeval ;
+  currenttimer            : tltimer  ;
+  selectresult:integer;
+begin
+  {$ifndef nosignal}
+    prepsigpipe;
+  {$endif}
+  {currentsocket := firstasin;
+  if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
+  repeat
+
+    if currentsocket.state = wsconnected then currentsocket.sendflush;
+    currentsocket := currentsocket.nextasin;
+  until not assigned(currentsocket);}
+
+
+  repeat
+
+    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
+    if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;
+    {fd_zero(FDSR);
+    fd_zero(FDSW);
+    currentsocket := firstasin;
+    if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
+
+    repeat
+      if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);
+      if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);
+      if currentsocket is tlsocket then begin
+         if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);
+      end;
+      tempsocket := currentsocket;
+      currentsocket := currentsocket.nextasin;
+      if tempsocket.released then begin
+        tempsocket.free;
+      end;
+    until not assigned(currentsocket);
+    }
+    processtasks;
+    //currenttask := nil;
+    {beware}
+    //if assigned(firsttimer) then begin
+    //  tv.tv_sec := maxlongint;
+    tv := tv_invalidtimebig;
+    currenttimer := firsttimer;
+    while assigned(currenttimer) do begin
+      if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
+      currenttimer := currenttimer.nexttimer;
+    end;
+
+
+    if tv_compare(tv,tv_invalidtimebig) then begin    
+      //writeln('no timers active');
+      if exitloopflag then break;
+{    sleep(10);}
+      selectresult := doselect(nil);
+
+    end else begin
+      gettimeofday(tvnow);
+      tv_substract(tv,tvnow);
+
+      //writeln('timers active');
+      if tv.tv_sec < 0 then begin
+        tv.tv_sec := 0;
+        tv.tv_usec := 0; {0.1 sec}
+      end;
+      if exitloopflag then break;
+{    sleep(10);}
+      selectresult := doselect(@tv);
+      processtimers;
+
+    end;
+    if selectresult > 0 then processasios(fdsr,fdsw);
+    {!!!only call processasios if select has asio events -beware}
+
+    {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
+  until false;
+end;
+
+var
+  fdsrmaster , fdswmaster               : fdset      ;
+
+procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
+begin
+  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
+  if fd > maxs then maxs := fd;
+  if fd_isset(fd,fdsrmaster) then exit;
+  fd_set(fd,fdsrmaster);
+
+end;
+
+procedure tselecteventcore.rmasterclr(fd: integer);
+begin
+  if not fd_isset(fd,fdsrmaster) then exit;
+  fd_clr(fd,fdsrmaster);
+
+end;
+
+
+procedure tselecteventcore.wmasterset(fd : integer);
+begin
+  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
+  if fd > maxs then maxs := fd;
+
+  if fd_isset(fd,fdswmaster) then exit;
+  fd_set(fd,fdswmaster);
+
+end;
+
+procedure tselecteventcore.wmasterclr(fd: integer);
+begin
+  if not fd_isset(fd,fdswmaster) then exit;
+  fd_clr(fd,fdswmaster);
+end;
+
+procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
+begin
+  fdreverse[fd] := reverseto;
+end;
+
+function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
+begin
+  result := fdsrmaster;
+end;
+function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
+begin
+  result := fdswmaster;
+end;
+
+
+begin
+  eventcore := tselecteventcore.create;
+
+  maxs := 0;
+  fd_zero(fdsrmaster);
+  fd_zero(fdswmaster);
+end.
diff --git a/httpserver_20080306/lcoretest.dpr b/httpserver_20080306/lcoretest.dpr
new file mode 100755
index 0000000..e9d1b0a
--- /dev/null
+++ b/httpserver_20080306/lcoretest.dpr
@@ -0,0 +1,167 @@
+program lcoretest;
+
+uses
+  lcore,
+  lsocket,
+  {$ifdef win32}
+    lcorewsaasyncselect in 'lcorewsaasyncselect.pas',
+  {$else}
+    lcoreselect,
+  {$endif}
+  dnsasync,
+  binipstuff,
+  dnssync;
+{$ifdef win32}
+  {$R *.RES}
+{$endif}
+
+type
+  tsc=class
+    procedure sessionavailable(sender: tobject;error : word);
+    procedure dataavailable(sender: tobject;error : word);
+    procedure sessionconnected(sender: tobject;error : word);
+    procedure taskrun(wparam,lparam:longint);
+    procedure timehandler(sender:tobject);
+    procedure dnsrequestdone(sender:tobject;error : word);
+    procedure sessionclosed(sender:tobject;error : word);
+  end;
+var
+  listensocket : tlsocket;
+  serversocket : tlsocket;
+  clientsocket : tlsocket;
+  sc : tsc;
+  task : tltask;
+procedure tsc.sessionavailable(sender: tobject;error : word);
+begin
+  writeln('received connection');
+  serversocket.dup(listensocket.accept);
+end;
+
+var
+  receivebuf : string;
+  receivecount : integer;
+procedure tsc.dataavailable(sender: tobject;error : word);
+var
+  receiveddata : string;
+  receivedon : string;
+begin
+  receiveddata := tlsocket(sender).receivestr;
+  if sender=clientsocket then begin
+    receivedon := 'client socket';
+  end else begin
+    receivedon := 'server socket';
+  end;
+  writeln('received data '+receiveddata+' on '+receivedon);
+  if sender=serversocket then begin
+    receivebuf := receivebuf+receiveddata;
+  end;
+  if receivebuf = 'hello world' then begin
+    receivebuf := '';
+    writeln('received hello world creating task');
+    task := tltask.create(sc.taskrun,nil,0,0);
+  end;
+  receivecount := receivecount +1;
+  if receivecount >50 then begin
+    writeln('received over 50 bits of data, pausing to let the operator take a look');
+    readln;
+    receivecount := 0;
+  end;
+
+end;
+
+procedure tsc.sessionconnected(sender: tobject;error : word);
+begin
+  if error=0 then begin
+    writeln('session is connected');
+    if clientsocket.addr = '127.0.0.1' then begin
+      clientsocket.sendstr('hello world');
+    end else begin
+      clientsocket.sendstr('get /'#13#10#13#10);
+    end;
+  end else begin
+    writeln('connect failed');
+  end;
+end;
+
+var
+  das : tdnsasync;
+
+procedure tsc.taskrun(wparam,lparam:longint);
+var
+  tempbinip : tbinip;
+  dummy : integer;
+begin
+  writeln('task ran');
+  writeln('closing client socket');
+  clientsocket.close;
+
+  writeln('looking up www.kame.net using dnsasync');
+  das := tdnsasync.Create(nil);
+  das.onrequestdone := sc.dnsrequestdone;
+  das.forwardfamily := af_inet6;
+  das.forwardlookup('www.kame.net');
+end;
+
+procedure tsc.dnsrequestdone(sender:tobject;error : word);
+begin
+  writeln('www.kame.net resolved to '+das.dnsresult+' connecting client socket there');
+  clientsocket.addr := das.dnsresult;
+  clientsocket.port := '80';
+  clientsocket.connect;
+  das.free;
+end;
+
+procedure tsc.timehandler(sender:tobject);
+begin
+  //writeln('got timer event');
+end;
+procedure tsc.sessionclosed(sender:tobject;error : word);
+begin
+  Writeln('session closed with error ',error);
+end;
+var
+  timer : tltimer;
+  ipbin : tbinip;
+  dummy : integer;
+begin
+  ipbin := forwardlookup('invalid.domain',5);
+  writeln(ipbintostr(ipbin));
+
+  ipbin := forwardlookup('p10link.net',5);
+  writeln(ipbintostr(ipbin));
+
+  ipstrtobin('80.68.89.68',ipbin);
+  writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));
+
+  ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);
+  writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));
+  writeln('creating and setting up listen socket');
+  listensocket := tlsocket.create(nil);
+  listensocket.addr := '0.0.0.0';
+  listensocket.port := '12345';
+  listensocket.onsessionavailable := sc.sessionavailable;
+  writeln('listening');
+  listensocket.listen;
+  writeln('listen socket is number ', listensocket.fdhandlein);
+  writeln('creating and setting up server socket');
+  serversocket := tlsocket.create(nil);
+  serversocket.ondataavailable := sc.dataavailable;
+  writeln('creating and setting up client socket');
+  clientsocket := tlsocket.create(nil);
+  clientsocket.addr := {'::1';}'127.0.0.1';
+  clientsocket.port := '12345';
+  clientsocket.onsessionconnected := sc.sessionconnected;
+  clientsocket.ondataAvailable := sc.dataavailable;
+  clientsocket.onsessionclosed := sc.sessionclosed;
+  writeln('connecting');
+  clientsocket.connect;
+  writeln('client socket is number ',clientsocket.fdhandlein);
+  writeln('creating and setting up timer');
+  timer := tltimer.create(nil);
+  timer.interval := 1000;
+  timer.ontimer := sc.timehandler;
+  timer.enabled := true;
+  writeln('entering message loop');
+  messageloop;
+  writeln('exiting cleanly');
+end.
diff --git a/httpserver_20080306/lcorewsaasyncselect.pas b/httpserver_20080306/lcorewsaasyncselect.pas
new file mode 100755
index 0000000..a978c23
--- /dev/null
+++ b/httpserver_20080306/lcorewsaasyncselect.pas
@@ -0,0 +1,216 @@
+unit lcorewsaasyncselect;
+
+interface
+
+implementation
+uses wcore,lcore,bsearchtree,sysutils,windows,winsock,pgtypes,messages,classes;
+type
+  twineventcore=class(teventcore)
+  public
+    procedure processmessages; override;
+    procedure messageloop; override;
+    procedure exitmessageloop;override;
+    procedure setfdreverse(fd : integer;reverseto : tlasio); override;
+    procedure rmasterset(fd : integer;islistensocket : boolean); override;
+    procedure rmasterclr(fd: integer); override;
+    procedure wmasterset(fd : integer); override;
+    procedure wmasterclr(fd: integer); override;
+  end;
+const
+  wm_dotasks=wm_user+1;
+type
+  twintimerwrapperinterface=class(ttimerwrapperinterface)
+  public
+    function createwrappedtimer : tobject;override;
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;
+  end;
+
+procedure twineventcore.processmessages;
+begin
+  wcore.processmessages;//pass off to wcore
+end;
+procedure twineventcore.messageloop;
+begin
+  wcore.messageloop; //pass off to wcore
+end;
+procedure twineventcore.exitmessageloop;
+begin
+  wcore.exitmessageloop;
+end;
+var
+  fdreverse : thashtable;
+  fdwatches : thashtable;
+
+procedure twineventcore.setfdreverse(fd : integer;reverseto : tlasio);
+begin
+  if findtree(@fdreverse,inttostr(fd)) <> nil then deltree(@fdreverse,inttostr(fd));
+  if reverseto <> nil then addtree(@fdreverse,inttostr(fd),reverseto);
+end;
+
+var
+  hwndlcore : hwnd;
+procedure dowsaasyncselect(fd:integer; leventadd: integer; leventremove : integer);
+var
+  leventold : integer;
+  leventnew : integer;
+  wsaaresult : integer;
+begin
+  leventold := taddrint(findtree(@fdwatches,inttostr(fd)));
+  leventnew := leventold or leventadd;
+  leventnew := leventnew and not leventremove;
+  if leventold <> leventnew then begin
+    if leventold <> 0 then deltree(@fdwatches,inttostr(fd));
+    if leventnew <> 0 then addtree(@fdwatches,inttostr(fd),pointer(leventnew));
+  end;
+  wsaaresult := wsaasyncselect(fd,hwndlcore,wm_user,leventnew);
+
+end;
+
+
+//to allow detection of errors:
+//if we are asked to monitor for read or accept we also monitor for close
+//if we are asked to monitor for write we also monitor for connect
+
+
+procedure twineventcore.rmasterset(fd : integer;islistensocket : boolean);
+begin
+  if islistensocket then begin
+    //writeln('setting accept watch for socket number ',fd);
+    dowsaasyncselect(fd,FD_ACCEPT or FD_CLOSE,0);
+  end else begin
+    //writeln('setting read watch for socket number',fd);
+    dowsaasyncselect(fd,FD_READ or FD_CLOSE,0);
+  end;
+end;
+procedure twineventcore.rmasterclr(fd: integer);
+begin
+  //writeln('clearing read of accept watch for socket number ',fd);
+  dowsaasyncselect(fd,0,FD_ACCEPT or FD_READ or FD_CLOSE);
+end;
+procedure twineventcore.wmasterset(fd : integer);
+begin
+  dowsaasyncselect(fd,FD_WRITE or FD_CONNECT,0);
+end;
+
+procedure twineventcore.wmasterclr(fd: integer);
+begin
+  dowsaasyncselect(fd,0,FD_WRITE or FD_CONNECT);
+end;
+
+var
+  tasksoutstanding : boolean;
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+  socket : integer;
+  event : integer;
+  error : integer;
+  readtrigger : boolean;
+  writetrigger : boolean;
+  lasio : tlasio;
+begin
+  //writeln('got a message');
+  Result := 0;  // This means we handled the message
+  if (ahwnd=hwndlcore) and (aumsg=wm_user) then begin
+    //writeln('it appears to be a response to our wsaasyncselect');
+    socket := awparam;
+    event := alparam and $FFFF;
+    error := alparam shr 16;
+    //writeln('socket=',socket,' event=',event,' error=',error);
+    readtrigger := false;
+    writetrigger := false;
+    lasio := findtree(@fdreverse,inttostr(socket));
+    if assigned(lasio) then begin
+      if (error <> 0) or ((event and FD_CLOSE) <> 0) then begin
+        if lasio.state = wsconnecting then begin
+          lasio.onsessionconnected(lasio,error);
+        end;
+        lasio.internalclose(error);
+      end else begin
+        if (event and (FD_READ or FD_ACCEPT)) <> 0 then readtrigger := true;
+        if (event and (FD_WRITE)) <> 0 then writetrigger := true;
+
+        if readtrigger or writetrigger then lasio.handlefdtrigger(readtrigger,writetrigger);
+      end;
+      dowsaasyncselect(socket,0,0); //reset watches
+    end;
+  end else if (ahwnd=hwndlcore) and (aumsg=wm_dotasks) then begin
+      //writeln('processing tasks');
+      tasksoutstanding := false;
+      processtasks;
+  end else begin
+      //writeln('passing unknown message to defwindowproc');
+      //not passing unknown messages on to defwindowproc will cause window
+      //creation to fail! --plugwash
+      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+
+end;
+
+procedure winaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  if not tasksoutstanding then PostMessage(hwndlcore,wm_dotasks,0,0);
+end;
+type
+  twcoretimer = wcore.tltimer;
+
+function twintimerwrapperinterface.createwrappedtimer : tobject;
+begin
+  result := twcoretimer.create(nil);
+end;
+procedure twintimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);
+begin
+  twcoretimer(wrappedtimer).ontimer := newvalue;
+end;
+procedure twintimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);
+begin
+  twcoretimer(wrappedtimer).enabled := newvalue;
+end;
+
+
+procedure twintimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);
+begin
+  twcoretimer(wrappedtimer).interval := newvalue;
+end;
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'lcoreClass');
+  GInitData: TWSAData;
+
+begin
+  eventcore := twineventcore.create;
+    if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create lcore handle, hinstance=',hinstance);
+  hwndlcore := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+  //writeln('lcore hwnd is ',hwndlcore);
+  //writeln('last error is ',GetLastError);
+  onaddtask := winaddtask;
+  timerwrapperinterface := twintimerwrapperinterface.create(nil);
+
+  WSAStartup($200, GInitData);
+end.
diff --git a/httpserver_20080306/lloopback.pas b/httpserver_20080306/lloopback.pas
new file mode 100755
index 0000000..da26263
--- /dev/null
+++ b/httpserver_20080306/lloopback.pas
@@ -0,0 +1,30 @@
+unit lloopback;
+
+interface
+uses lcore,classes;
+
+type
+  tlloopback=class(tlasio)
+  public
+    constructor create(aowner:tcomponent); override;
+  end;
+
+
+implementation
+uses
+  baseunix,unix;
+{$i unixstuff.inc}
+
+constructor tlloopback.create(aowner:tcomponent);
+begin
+  inherited create(aowner);
+  closehandles := true;
+  assignpipe(fdhandlein,fdhandleout);
+
+  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
+  eventcore.wmasterclr(fdhandlein);//fd_clr(fdhandleout,fdswmaster);
+  eventcore.setfdreverse(fdhandlein,self);
+  eventcore.setfdreverse(fdhandleout,self);
+  state := wsconnected;
+end;
+end.
diff --git a/httpserver_20080306/lmessages.pas b/httpserver_20080306/lmessages.pas
new file mode 100755
index 0000000..7bb73fd
--- /dev/null
+++ b/httpserver_20080306/lmessages.pas
@@ -0,0 +1,656 @@
+unit lmessages;
+//windows messages like system based on lcore tasks
+interface
+
+uses pgtypes,sysutils,bsearchtree,strings,syncobjs;
+
+type
+  lparam=taddrint;
+  wparam=taddrint;
+  thinstance=pointer;
+  hicon=pointer;
+  hcursor=pointer;
+  hbrush=pointer;
+  hwnd=qword; //window handles are monotonically increasing 64 bit integers,
+              //this should allow for a million windows per second for over half
+              //a million years!
+
+  twndproc=function(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+
+
+  twndclass=record
+    style : dword;
+    lpfnwndproc : twndproc;
+    cbclsextra : integer;
+    cbwndextra : integer;
+    hinstance : thinstance;
+    hicon : hicon;
+    hcursor : hcursor;
+    hbrbackground : hbrush;
+    lpszmenuname : pchar;
+    lpszclassname : pchar;
+  end;
+  PWNDCLASS=^twndclass;
+  
+  UINT=dword;
+  WINBOOL = longbool;
+  tTIMERPROC = procedure (ahwnd:HWND; umsg:integer; idevent:taddrint;dwtime:taddrint);stdcall;
+  ATOM = pointer;
+  LPCSTR = pchar;
+  LPVOID = pointer;
+  HMENU = pointer;
+  HINST = pointer;
+
+  TPOINT = record 
+    x : LONGint; 
+    y : LONGint; 
+  end; 
+  
+  TMSG = record 
+    hwnd : HWND; 
+    message : UINT; 
+    wParam : WPARAM; 
+    lParam : LPARAM; 
+    time : DWORD; 
+    pt : TPOINT;
+  end; 
+  THevent=TEventObject;
+const
+  WS_EX_TOOLWINDOW = $80;
+  WS_POPUP = longint($80000000);
+  hinstance=nil;
+  PM_REMOVE = 1;
+  WM_USER = 1024;
+  WM_TIMER = 275;
+  INFINITE = syncobjs.infinite;
+function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
+function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
+function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
+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;
+function DestroyWindow(ahWnd:HWND):WINBOOL;
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
+function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
+function DispatchMessage(const lpMsg: TMsg): Longint;
+function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
+function SetEvent(hEvent:THevent):WINBOOL;
+function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
+function terminatethread(threadhandle : tthreadid;dummy:integer) : boolean;
+function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
+function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
+function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
+
+procedure init;
+
+implementation
+uses
+  baseunix,unix,lcore;//,safewriteln;
+{$i unixstuff.inc}
+
+type
+  tmessageintransit = class
+    msg : tmsg;
+    next : tmessageintransit;
+  end;
+
+  tthreaddata = class
+    messagequeue : tmessageintransit;
+    messageevent : teventobject;
+    waiting : boolean;
+    lcorethread : boolean;
+    nexttimer : ttimeval;
+    threadid : integer;
+  end;
+  twindow=class
+    hwnd : hwnd;
+    extrawindowmemory : pointer;
+    threadid : tthreadid;
+    windowproc : twndproc;
+  end;
+
+var
+  structurelock : tcriticalsection;
+  threaddata : thashtable;
+  windowclasses : thashtable;
+  lcorelinkpipesend : integer;
+  lcorelinkpiperecv : tlasio;
+  windows : thashtable;
+  //I would rather things crash immediately
+  //if they use an insufficiant size type
+  //than crash after over four billion
+  //windows have been made ;)
+  nextwindowhandle : qword = $100000000;
+{$i ltimevalstuff.inc}
+
+//findthreaddata should only be called while holding the structurelock
+function findthreaddata(threadid : integer) : tthreaddata;
+begin
+  result := tthreaddata(findtree(@threaddata,inttostr(threadid)));
+  if result = nil then begin
+    result := tthreaddata.create;
+    result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));
+    result.nexttimer := tv_invalidtimebig;
+    result.threadid := threadid;
+    addtree(@threaddata,inttostr(threadid),result);
+  end;
+end;
+
+//deletethreaddataifunused should only be called while holding the structurelock
+procedure deletethreaddataifunused(athreaddata : tthreaddata);
+begin
+  //writeln('in deletethreaddataifunused');
+  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
+    //writeln('threaddata is unused, freeing messageevent');
+    athreaddata.messageevent.free;
+    //writeln('freeing thread data object');
+    athreaddata.free;
+    //writeln('deleting thread data object from hashtable');
+    deltree(@threaddata,inttostr(athreaddata.threadid));
+    //writeln('finished deleting thread data');
+  end else begin
+    //writeln('thread data is not unused');
+  end;
+end;
+
+function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
+var
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window <> nil then begin
+      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
+    end else begin
+      result := 0;
+    end;
+  finally
+    structurelock.release;
+  end;
+end;
+
+function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
+var
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window <> nil then begin
+      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
+      paddrint(taddrint(window.extrawindowmemory)+nindex)^ := dwnewlong;
+    end else begin
+      result := 0;
+    end;
+  finally
+    structurelock.release;
+  end;
+
+end;
+
+
+function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+begin
+  result := 0;
+end;
+
+function strdup(s:pchar) : pchar;
+begin
+  //swriteln('in strdup, about to allocate memory');
+  result := getmem(strlen(s)+1);
+  //swriteln('about to copy string');
+  strcopy(s,result);
+  //swriteln('leaving strdup');
+end;
+
+function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
+var
+  storedwindowclass:pwndclass;
+begin
+  structurelock.acquire;
+  try
+    //swriteln('in registerclass, about to check for duplicate window class');
+    storedwindowclass := findtree(@windowclasses, lpwndclass.lpszclassname);
+    if storedwindowclass <> nil then begin
+
+      if comparebyte(storedwindowclass^,lpwndclass,sizeof(twndclass)-sizeof(pchar)-sizeof(pchar)) <> 0 then begin
+        //swriteln('duplicate window class registered with different settings');
+        raise exception.create('duplicate window class registered with different settings');
+      end else begin
+        //swriteln('duplicate window class registered with same settings, tollerated');
+      end;
+    end else begin
+      //swriteln('about to allocate memory for new windowclass');
+      storedwindowclass := getmem(sizeof(twndclass));
+      //swriteln('about to copy windowclass from parameter');
+      move(lpwndclass,storedwindowclass^,sizeof(twndclass));
+      //swriteln('about to copy strings');
+      if lpwndclass.lpszmenuname <> nil then storedwindowclass.lpszmenuname := strdup(lpwndclass.lpszmenuname);
+      if lpwndclass.lpszclassname <> nil then storedwindowclass.lpszclassname := strdup(lpwndclass.lpszclassname);
+      //swriteln('about to add result to list of windowclasses');
+      addtree(@windowclasses,lpwndclass.lpszclassname,storedwindowclass);
+    end;
+    //swriteln('about to return result');
+    result := storedwindowclass;
+    //swriteln('leaving registerclass');
+  finally
+    structurelock.release;
+  end;
+end;
+
+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;
+var
+  wndclass : pwndclass;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := twindow.create;
+    window.hwnd := nextwindowhandle;
+    result := window.hwnd;
+    nextwindowhandle := nextwindowhandle + 1;
+    addtree(@windows,inttostr(window.hwnd),window);
+    wndclass := findtree(@windowclasses,lpclassname);
+    window.extrawindowmemory := getmem(wndclass.cbwndextra);
+
+    getthreadmanager(tm);
+    window.threadid := tm.GetCurrentThreadId;
+    window.windowproc := wndclass.lpfnwndproc;
+  finally
+    structurelock.release;
+  end;
+end;
+function DestroyWindow(ahWnd:HWND):WINBOOL;
+var
+  window : twindow;
+  windowthreaddata : tthreaddata;
+  currentmessage : tmessageintransit;
+  prevmessage : tmessageintransit;
+begin
+  //writeln('started to destroy window');
+  structurelock.acquire;
+  try
+    window := twindow(findtree(@windows,inttostr(ahwnd)));
+    if window <> nil then begin
+      freemem(window.extrawindowmemory);
+      //writeln('aboute to delete window from windows structure');
+      deltree(@windows,inttostr(ahwnd));
+      //writeln('deleted window from windows structure');
+      windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));
+
+      if windowthreaddata <> nil then begin
+        //writeln('found thread data scanning for messages to clean up');
+        currentmessage := windowthreaddata.messagequeue;
+        prevmessage := nil;
+        while currentmessage <> nil do begin
+          while (currentmessage <> nil) and (currentmessage.msg.hwnd = ahwnd) do begin
+            if prevmessage = nil then begin
+              windowthreaddata.messagequeue := currentmessage.next;
+            end else begin
+              prevmessage.next := currentmessage.next;
+            end;
+            currentmessage.free;
+            if prevmessage = nil then begin
+              currentmessage := windowthreaddata.messagequeue;
+            end else begin
+              currentmessage := prevmessage.next;
+            end;
+          end;
+          if currentmessage <> nil then begin
+            prevmessage := currentmessage;
+            currentmessage := currentmessage.next;
+          end;
+        end;
+        //writeln('deleting thread data structure if it is unused');
+        deletethreaddataifunused(windowthreaddata);
+      end else begin
+        //writeln('there is no thread data to search for messages to cleanup');
+      end;
+      //writeln('freeing window');
+      window.free;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  finally
+    structurelock.release;
+  end;
+  //writeln('window destroyed');
+end;
+
+
+
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
+var
+  threaddata : tthreaddata;
+  message : tmessageintransit;
+  messagequeueend : tmessageintransit;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(hwnd));
+    if window <> nil then begin
+      threaddata := findthreaddata(window.threadid);
+      message := tmessageintransit.create;
+      message.msg.hwnd := hwnd;
+      message.msg.message := msg;
+      message.msg.wparam := wparam;
+      message.msg.lparam := lparam;
+      if threaddata.lcorethread then begin
+        //swriteln('posting message to lcore thread');
+        fdwrite(lcorelinkpipesend,message,sizeof(message));
+      end else begin
+        //writeln('posting message to non lcore thread');
+        if threaddata.messagequeue = nil then begin
+          threaddata.messagequeue := message;
+        end else begin
+          messagequeueend := threaddata.messagequeue;
+          while messagequeueend.next <> nil do begin
+            messagequeueend := messagequeueend.next;
+          end;
+          messagequeueend.next := message;
+        end;
+
+        //writeln('message added to queue');
+        if threaddata.waiting then threaddata.messageevent.setevent;
+      end;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  finally
+    structurelock.release;
+  end;
+
+end;
+
+function gettickcount : dword;
+var
+  result64: integer;
+  tv : ttimeval;
+begin
+  gettimeofday(tv);
+  result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);
+  result := result64;
+end;
+
+function DispatchMessage(const lpMsg: TMsg): Longint;
+var
+  timerproc : ttimerproc;
+  window : twindow;
+  windowproc : twndproc;
+begin
+  ////swriteln('in dispatchmessage, msg.hwnd='+inttohex(taddrint(lpmsg.hwnd),16));
+  if (lpmsg.lparam <> 0) and (lpmsg.message = WM_TIMER) then begin
+    timerproc := ttimerproc(lpmsg.lparam);
+    timerproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,gettickcount);
+    result := 0;
+  end else begin
+    structurelock.acquire;
+    try
+      window := findtree(@windows,inttostr(lpmsg.hwnd));
+      //we have to get the window procedure while the structurelock
+      //is still held as the window could be destroyed from another thread
+      //otherwise.
+      windowproc := window.windowproc;
+    finally
+      structurelock.release;
+    end;
+    if window <> nil then begin
+      result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);
+    end else begin
+      result := -1;
+    end;
+  end;
+end;
+
+procedure processtimers;
+begin
+end;
+
+function GetMessageinternal(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT; wremovemsg : UINT;peek:boolean): WINBOOL;
+var
+  tm : tthreadmanager;
+  threaddata : tthreaddata;
+  message : tmessageintransit;
+  nowtv : ttimeval;
+  timeouttv : ttimeval;
+  timeoutms : int64;
+
+begin
+  if hwnd <> 0 then raise exception.create('getting messages for an individual window is not supported');
+  if (wmsgfiltermin <> 0) or (wmsgfiltermax <> 0) then raise exception.create('message filtering is not supported');
+  structurelock.acquire;
+  result := true;
+  try
+    getthreadmanager(tm);
+    threaddata := findthreaddata(tm.GetCurrentThreadId);
+    if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');
+    message := threaddata.messagequeue;
+    gettimeofday(nowtv);
+    while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin
+      threaddata.waiting := true;
+      structurelock.release;
+      if (threaddata.nexttimer.tv_sec = TV_invalidtimebig.tv_sec) and (threaddata.nexttimer.tv_usec = TV_invalidtimebig.tv_usec) then begin
+        threaddata.messageevent.waitfor(INFINITE);
+      end else begin
+
+        timeouttv := threaddata.nexttimer;
+        timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);
+        //i'm assuming the timeout is in milliseconds
+        if (timeoutms > maxlongint) then timeoutms := maxlongint;
+        threaddata.messageevent.waitfor(timeoutms);
+
+      end;
+      structurelock.acquire;
+      threaddata.waiting := false;
+      message := threaddata.messagequeue;
+      gettimeofday(nowtv);
+    end;
+    if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin
+      processtimers;
+    end;
+    message := threaddata.messagequeue;
+    if message <> nil then begin
+      lpmsg := message.msg;
+      if wremovemsg=PM_REMOVE then begin
+        threaddata.messagequeue := message.next;
+        message.free;
+      end;
+    end else begin
+      result :=false;
+    end;
+    deletethreaddataifunused(threaddata);
+  finally
+    structurelock.release;
+  end;
+end;
+
+function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
+begin
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,false);
+end;
+
+function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
+begin
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);
+end;
+
+function SetEvent(hEvent:THevent):WINBOOL;
+begin
+  hevent.setevent;
+  result := true;
+end;
+
+function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
+begin
+  result := teventobject.create(lpeventattributes,bmanualreset,binitialstate,lpname);
+end;
+
+function terminatethread(threadhandle:tthreadid;dummy : integer) : boolean;
+var
+  tm : tthreadmanager;
+begin
+  getthreadmanager(tm);
+  tm.killthread(threadhandle);
+  result := true;
+end;
+
+function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
+begin
+  result := event.waitfor(timeout);
+end;
+
+procedure removefrombuffer(n : integer; var buffer:string);
+begin
+  if n=length(buffer) then begin
+    buffer := '';
+  end else begin
+    uniquestring(buffer);
+    move(buffer[n+1],buffer[1],length(buffer)-n);
+    setlength(buffer,length(buffer)-n);
+  end;
+end;
+
+type
+  tsc=class
+    procedure available(sender:tobject;error:word);
+  end;
+
+var
+  recvbuf : string;
+
+procedure tsc.available(sender:tobject;error:word);
+var
+  message : tmessageintransit;
+  messagebytes : array[1..sizeof(tmessageintransit)] of char absolute  message;
+  i : integer;
+begin
+  //swriteln('received data on lcorelinkpipe');
+  recvbuf := recvbuf + lcorelinkpiperecv.receivestr;
+  while length(recvbuf) >= sizeof(tmessageintransit) do begin
+    for i := 1 to sizeof(tmessageintransit) do begin
+      messagebytes[i] := recvbuf[i];
+    end;
+    dispatchmessage(message.msg);
+    message.free;
+    removefrombuffer(sizeof(tmessageintransit),recvbuf);
+  end;
+end;
+
+procedure init;
+var
+  tm : tthreadmanager;
+  threaddata : tthreaddata;
+  pipeends : tfildes;
+  sc : tsc;
+begin
+  structurelock := tcriticalsection.create;
+  getthreadmanager(tm);
+  threaddata := findthreaddata(tm.GetCurrentThreadId);
+  threaddata.lcorethread := true;
+  fppipe(pipeends);
+  lcorelinkpipesend := pipeends[1];
+  lcorelinkpiperecv := tlasio.create(nil);
+  lcorelinkpiperecv.dup(pipeends[0]);
+  lcorelinkpiperecv.ondataavailable := sc.available;
+  recvbuf := '';
+end;
+
+var
+  lcorethreadtimers : thashtable;
+type
+  tltimerformsg = class(tltimer)
+  public
+    hwnd : hwnd;
+    id : taddrint;
+    procedure timer(sender : tobject);
+  end;
+
+procedure tltimerformsg.timer(sender : tobject);
+var
+  msg : tmsg;
+begin
+  ////swriteln('in tltimerformsg.timer');
+  fillchar(msg,sizeof(msg),0);
+  msg.message := WM_TIMER;
+  msg.hwnd := hwnd;
+  msg.wparam := ID;
+  msg.lparam := 0;
+  dispatchmessage(msg);
+end;
+
+function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
+var
+  threaddata : tthreaddata;
+  ltimer : tltimerformsg;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window= nil then raise exception.create('invalid window');
+    threaddata := findthreaddata(window.threadid);
+  finally
+    structurelock.release;
+  end;
+  if threaddata.lcorethread then begin
+    getthreadmanager(tm);
+    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and removed from the lcore thread');
+    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
+    if @lptimerfunc <> nil then raise exception.create('seperate timer functions are not supported');
+
+    //remove preexisting timer with same ID
+    killtimer(ahwnd,nIDEvent);
+
+    ltimer := tltimerformsg.create(nil);
+    ltimer.interval := uelapse;
+    ltimer.id := nidevent;
+    ltimer.hwnd := ahwnd;
+    ltimer.enabled := true;
+    ltimer.ontimer := ltimer.timer;
+
+    addtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(nIDEvent),ltimer);
+
+    result := nidevent;
+  end else begin
+    raise exception.create('settimer not implemented for threads other than the lcore thread');
+  end;
+end;
+
+function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
+var
+  threaddata : tthreaddata;
+  ltimer : tltimerformsg;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window= nil then raise exception.create('invalid window');
+    threaddata := findthreaddata(window.threadid);
+  finally
+    structurelock.release;
+  end;
+  if threaddata.lcorethread then begin
+    getthreadmanager(tm);
+    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and remove from the lcore thread');
+    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
+    ltimer := tltimerformsg(findtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent)));
+    if ltimer <> nil then begin
+      deltree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent));
+      ltimer.free;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  end else begin
+    raise exception.create('settimer not implemented for threads other than the lcore thread');
+  end;
+end;
+
+end.
\ No newline at end of file
diff --git a/httpserver_20080306/lsignal.pas b/httpserver_20080306/lsignal.pas
new file mode 100755
index 0000000..573fe28
--- /dev/null
+++ b/httpserver_20080306/lsignal.pas
@@ -0,0 +1,198 @@
+{lsocket.pas}
+
+{signal code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+      
+unit lsignal;
+{$mode delphi}
+interface
+  uses sysutils,
+    {$ifdef VER1_0}
+      linux,
+    {$else}
+      baseunix,unix,
+    {$endif}
+    classes,lcore,lloopback;
+
+  type
+    tsignalevent=procedure(sender:tobject;signal:integer) of object;
+    tlsignal=class(tcomponent)
+    public
+      onsignal           : tsignalevent      ;
+      prevsignal         : tlsignal          ;
+      nextsignal         : tlsignal          ;
+
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+    end;
+
+  
+  procedure starthandlesignal(signal:integer);
+
+var
+  firstsignal : tlsignal;
+  blockset : sigset;
+  signalloopback                        : tlloopback ;
+  
+implementation
+{$include unixstuff.inc}
+
+constructor tlsignal.create;
+begin
+  inherited create(AOwner);
+  nextsignal := firstsignal;
+  prevsignal := nil;
+
+  if assigned(nextsignal) then nextsignal.prevsignal := self;
+  firstsignal := self;
+
+  //interval := 1000;
+  //enabled := true;
+  //released := false;
+end;
+
+destructor tlsignal.destroy;
+begin
+  if prevsignal <> nil then begin
+    prevsignal.nextsignal := nextsignal;
+  end else begin
+    firstsignal := nextsignal;
+  end;
+  if nextsignal <> nil then begin
+    nextsignal.prevsignal := prevsignal;
+  end;
+  inherited destroy;
+end;
+{$ifdef linux}
+  {$ifdef ver1_9_8}
+    {$define needsignalworkaround}
+  {$endif}
+  {$ifdef ver2_0_0}
+    {$define needsignalworkaround}
+  {$endif}
+  {$ifdef ver2_0_2}
+    {$define needsignalworkaround}
+  {$endif}
+{$endif}
+{$ifdef needsignalworkaround}
+  //using the 1.9.6 version of this stuff because the 1.9.8 and 2.0.0 versions seem broken
+  type
+    TSysParam  = Longint;
+    TSysResult = longint;
+  const
+            syscall_nr_sigaction		= 67;
+  //function Do_SysCall(sysnr:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
+  //function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
+  //function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
+  function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
+  //function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
+  //function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
+
+  function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint;// [public, alias : 'FPC_SYSC_SIGACTION'];
+  {
+    Change action of process upon receipt of a signal.
+    Signum specifies the signal (all except SigKill and SigStop).
+    If Act is non-nil, it is used to specify the new action.
+    If OldAct is non-nil the previous action is saved there.
+  }
+  begin
+  //writeln('fucking');
+  {$ifdef RTSIGACTION}
+    {$ifdef cpusparc}
+      { Sparc has an extra stub parameter }
+      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));
+    {$else cpusparc}
+      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));
+    {$endif cpusparc}
+  {$else RTSIGACTION}
+    //writeln('nice');
+    Fpsigaction:=do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
+  {$endif RTSIGACTION}
+  end;
+{$endif}
+
+// cdecl procedures are not name mangled
+// so USING something unlikely to cause colliesions in the global namespace
+// is a good idea
+procedure lsignal_handler( Sig : Integer);cdecl;
+var
+  currentsignal : tlsignal;
+begin
+//  writeln('in lsignal_hanler');
+  currentsignal := firstsignal;
+  while assigned(currentsignal) do begin
+    if assigned(currentsignal.onsignal) then currentsignal.onsignal(currentsignal,sig);
+    currentsignal := currentsignal.nextsignal;
+
+  end;
+//  writeln('about to send down signalloopback');
+  if assigned(signalloopback) then begin
+    signalloopback.sendstr(' ');
+  end;
+//  writeln('left lsignal_hanler');
+end;
+
+{$ifdef freebsd}
+
+{$if (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))}
+procedure lsignal_handler2(signal:longint;info:PSigInfo;context:psigcontext); cdecl;
+{$else}
+procedure lsignal_handler2(signal:longint;var info:TSigInfo_t;var context:SigContextRec); cdecl;
+{$endif}
+
+begin
+  lsignal_handler(signal);
+end;
+{$endif}
+
+
+const
+  allbitsset=-1;
+  {$ifdef ver1_0}
+    saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
+  {$else}
+    {$ifdef darwin}
+      saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
+    {$else}
+      {$ifdef freebsd}
+        //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
+        {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
+          saction : sigactionrec = (sa_handler:lsignal_handler2;sa_flags:0);
+        {$else}
+          saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
+        {$endif}
+							  
+      {$else}
+        {$ifdef ver1_9_2}
+          saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
+        {$else}
+	  //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
+	  {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
+	    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);
+	  {$else}
+            saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_6}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler));
+	  {$endif}
+        {$endif}
+      {$endif}
+    {$endif}
+  {$endif}
+procedure starthandlesignal(signal:integer);
+begin
+  if signal in ([0..31]-[sigkill,sigstop]) then begin
+    sigprocmask(SIG_BLOCK,@blockset,nil);
+    sigaction(signal,@saction,nil)
+  end else begin
+    raise exception.create('invalid signal number')
+  end;
+end;
+
+initialization
+  fillchar(blockset,sizeof(blockset),0);
+  blockset[0] := $FFFFFFFF - (1 shl sigstop) - (1 shl sigkill) - (1 shl sigsegv);
+  saction.sa_mask := blockset;
+  
+end.
diff --git a/httpserver_20080306/lsocket.pas b/httpserver_20080306/lsocket.pas
new file mode 100755
index 0000000..617f153
--- /dev/null
+++ b/httpserver_20080306/lsocket.pas
@@ -0,0 +1,706 @@
+{lsocket.pas}
+
+{socket code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+{
+changes by plugwash (20030728)
+* created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it
+* changed tlasio to tlasio
+* split fdhandle into fdhandlein and fdhandleout
+* i now use fdsrmaster and fdswmaster instead of rebuilding the lists every loop
+* split lsocket.pas into lsocket.pas and lcore.pas
+
+
+changes by beware (20030903)
+* added getxaddr, getxport (local addr, port, as string)
+* added getpeername, remote addr+port as binary
+* added htons and htonl functions (endian swap, same interface as windows API)
+
+beware (20030905)
+* if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose)
+* (lcore) if closing the fd's in internalcose, set fd's to -1 because closing an fd makes it invalid
+
+beware (20030927)
+* fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check
+
+beware (20031017)
+* added getpeeraddr, getpeerport, remote addr+port as string
+}
+
+
+unit lsocket;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+interface
+  uses
+    sysutils,
+    {$ifdef win32}
+      windows,winsock,
+    {$else}
+
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,
+      {$endif}
+      sockets,
+    {$endif}
+    classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync;
+type
+  sunB = packed record
+    s_b1, s_b2, s_b3, s_b4: byte;
+  end;
+
+  SunW = packed record
+    s_w1, s_w2: word;
+  end;
+
+  TInAddr = packed record
+    case integer of
+      0: (S_un_b: SunB);
+      1: (S_un_w: SunW);
+      2: (S_addr: cardinal);
+  end;
+  {$ifdef ipv6}
+    {$ifdef ver1_0}
+      cuint16=word;
+      cuint32=dword;
+      sa_family_t=word;
+
+
+      TInetSockAddr6 = packed Record
+        sin6_family   : sa_family_t;
+        sin6_port     : cuint16;
+        sin6_flowinfo : cuint32;
+        sin6_addr     : Tin6_addr;
+        sin6_scope_id : cuint32;
+      end;
+    {$endif}
+  {$endif}
+  TinetSockAddrv = packed record
+    case integer of
+      0: (InAddr:TInetSockAddr);
+      {$ifdef ipv6}
+      1: (InAddr6:TInetSockAddr6);
+      {$endif}
+  end;
+  Pinetsockaddrv = ^Tinetsockaddrv;
+
+
+  type
+    tsockaddrin=TInetSockAddr;
+
+  type
+    TLsocket = class(tlasio)
+    public
+      //a: string;
+
+      inAddr             : TInetSockAddrV;
+{      inAddrSize:integer;}
+
+      //host               : THostentry      ;
+
+      //mainthread         : boolean         ; //for debuggin only
+      addr:string;
+      port:string;
+      localaddr:string;
+      localport:string;
+      proto:string;
+      udp:boolean;
+      listenqueue:integer;
+      function getaddrsize:integer;
+      procedure connect; virtual;
+      procedure bindsocket;
+      procedure listen;
+      function accept : longint;
+      function sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer; virtual;
+      function receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer; virtual;
+      //procedure internalclose(error:word);override;
+      procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
+      function send(data:pointer;len:integer):integer;override;
+      procedure sendstr(const str : string);override;
+      function Receive(Buf:Pointer;BufSize:integer):integer; override;
+      function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;
+      procedure getXaddrbin(var binip:tbinip); virtual;
+      procedure getpeeraddrbin(var binip:tbinip); virtual;
+      function getXaddr:string; virtual;
+      function getpeeraddr:string; virtual;
+      function getXport:string; virtual;
+      function getpeerport:string; virtual;
+      constructor Create(AOwner: TComponent); override;
+      {$ifdef win32}
+        procedure myfdclose(fd : integer); override;
+        function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;
+        function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override;
+      {$endif}
+    end;
+    tsocket=longint; // for compatibility with twsocket
+
+  twsocket=tlsocket; {easy}
+
+function htons(w:word):word;
+function htonl(i:integer):integer;
+{!!!function longipdns(s:string):longint;}
+
+{$ifdef ipv6}
+const
+  v4listendefault:boolean=false;
+{$endif}
+
+
+const
+  TCP_NODELAY=1;
+  IPPROTO_TCP=6;
+
+implementation
+{$include unixstuff.inc}
+
+function longip(s:string):longint;{$ifdef fpc}inline;{$endif}
+var
+  l:longint;
+  a,b:integer;
+
+function convertbyte(const s:string):integer;{$ifdef fpc}inline;{$endif}
+begin
+  result := strtointdef(s,-1);
+  if result < 0 then exit;
+  if result > 255 then exit;
+
+  {01 exception}
+  if (result <> 0) and (s[1] = '0') then begin
+    result := -1;
+    exit;
+  end;
+
+  {+1 exception}
+  if not (s[1] in ['0'..'9']) then begin
+    result := -1;
+    exit
+  end;
+end;
+
+begin
+  result := 0;
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := b shl 24;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 16;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 8;
+  s := copy(s,a+1,256);
+  b := convertbyte(copy(s,1,256));if (b < 0) then exit;
+  l := l or b;
+  result := l;
+end;
+
+(*!!!
+function longipdns(s:string):longint;
+var
+  host : thostentry;
+begin
+  if s = '0.0.0.0' then begin
+    result := 0;
+  end else begin
+    result := longip(s);
+    if result = 0 then begin
+      if gethostbyname(s,host) then begin;
+        result := htonl(Longint(Host.Addr));
+      end;
+      //writeln(inttohex(longint(host.addr),8))
+    end;
+    if result = 0 then begin
+      if resolvehostbyname(s,host) then begin;
+        result := htonl(Longint(Host.Addr));
+      end;
+      //writeln(inttohex(longint(host.addr),8))
+    end;
+  end;
+end;
+*)
+
+
+function htons(w:word):word;
+begin
+  {$ifndef ENDIAN_BIG}
+  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
+  {$else}
+  result := w;
+  {$endif}
+end;
+
+function htonl(i:integer):integer;
+begin
+  {$ifndef ENDIAN_BIG}
+  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
+  {$else}
+  result := i;
+  {$endif}
+end;
+
+function tlsocket.getaddrsize:integer;
+begin
+  {$ifdef ipv6}
+  if inaddr.inaddr.family = AF_INET6 then result := sizeof(tinetsockaddr6) else
+  {$endif}
+  result := sizeof(tinetsockaddr);
+end;
+
+function makeinaddrv(addr,port:string;var inaddr:tinetsockaddrv):integer;
+var
+  biniptemp:tbinip;
+begin
+  result := 0;
+  biniptemp := forwardlookup(addr,10);
+  fillchar(inaddr,sizeof(inaddr),0);
+  //writeln('converted address '+addr+' to binip '+ipbintostr(biniptemp));
+  if biniptemp.family = AF_INET then begin
+    inAddr.InAddr.family:=AF_INET;
+    inAddr.InAddr.port:=htons(strtointdef(port,0));
+    inAddr.InAddr.addr:=biniptemp.ip;
+    result := sizeof(tinetsockaddr);
+  end else
+  {$ifdef ipv6}
+  if biniptemp.family = AF_INET6 then begin
+    inAddr.InAddr6.sin6_family:=AF_INET6;
+    inAddr.InAddr6.sin6_port:=htons(strtointdef(port,0));
+    inAddr.InAddr6.sin6_addr:=biniptemp.ip6;
+    result := sizeof(tinetsockaddr6);
+  end else
+  {$endif}
+  raise esocketexception.create('unable to resolve address: '+addr);
+end;
+
+procedure tlsocket.connect;
+var
+  a:integer;
+begin
+  if state <> wsclosed then close;
+  //prevtime := 0;
+  makeinaddrv(addr,port,inaddr);
+
+  udp := uppercase(proto) = 'UDP';
+  if udp then a := SOCK_DGRAM else a := SOCK_STREAM;
+  a := Socket(inaddr.inaddr.family,a,0);
+
+  //writeln(ord(inaddr.inaddr.family));
+  if a = -1 then begin
+    lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
+    raise esocketexception.create('unable to create socket');
+  end;
+  try
+    dup(a);
+    bindsocket;
+    if udp then begin
+      {$ifndef win32}
+        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
+      {$endif}
+      state := wsconnected;
+      if assigned(onsessionconnected) then onsessionconnected(self,0);
+    end else begin
+      state :=wsconnecting;
+      {$ifdef win32}
+        //writeln(inaddr.inaddr.port);
+        winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
+      {$else}
+        sockets.Connect(fdhandlein,inADDR,getaddrsize);
+      {$endif}
+    end;
+    eventcore.rmasterset(fdhandlein,false);
+    if udp then begin
+      eventcore.wmasterclr(fdhandleout);
+    end else begin
+      eventcore.wmasterset(fdhandleout);
+    end;
+    //sendq := '';
+  except
+    on e: exception do begin
+      fdcleanup;
+      raise; //reraise the exception
+    end;
+  end;
+end;
+
+procedure tlsocket.sendstr(const str : string);
+begin
+  if udp then begin
+    send(@str[1],length(str))
+  end else begin
+    inherited sendstr(str);
+  end;
+end;
+
+function tlsocket.send(data:pointer;len:integer):integer;
+begin
+  if udp then begin
+    //writeln('sending to '+inttohex(inaddr.inaddr.addr,8));
+    result := sendto(inaddr.inaddr,getaddrsize,data,len)
+;
+    //writeln('send result',result);
+    //writeln('errno',errno);
+  end else begin
+    result := inherited send(data,len);
+  end;
+end;
+
+
+function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
+begin
+  if udp then begin
+    result := myfdread(self.fdhandlein,buf^,bufsize);
+  end else begin
+    result := inherited receive(buf,bufsize);
+  end;
+end;
+
+procedure tlsocket.bindsocket;
+var
+  a:integer;
+  inAddrtemp:TInetSockAddrV;
+  inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
+  inaddrtempsize:integer;
+begin
+  try
+    if (localaddr <> '') or (localport <> '') then begin
+      if localaddr = '' then begin
+        {$ifdef ipv6}
+        if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
+        {$endif}
+        localaddr := '0.0.0.0';
+      end;
+      //gethostbyname(localaddr,host);
+
+      inaddrtempsize := makeinaddrv(localaddr,localport,inaddrtemp);
+
+      If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin
+        state := wsclosed;
+        lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
+        raise ESocketException.create('unable to bind, error '+inttostr(lasterror));
+      end;
+      state := wsbound;
+    end;
+  except
+    on e: exception do begin
+      fdcleanup;
+      raise; //reraise the exception
+    end;
+  end;
+end;
+
+procedure tlsocket.listen;
+var
+  yes:longint;
+  socktype:integer;
+  biniptemp:tbinip;
+  origaddr:string;
+begin
+  if state <> wsclosed then close;
+  udp := uppercase(proto) = 'UDP';
+  if udp then socktype := SOCK_DGRAM else socktype := SOCK_STREAM;
+  origaddr := addr;
+
+  if addr = '' then begin
+    {$ifdef ipv6}
+    if not v4listendefault then begin
+      addr := '::';
+    end else
+    {$endif}
+    addr := '0.0.0.0';
+  end;
+  biniptemp := forwardlookup(addr,10);
+  addr := ipbintostr(biniptemp);
+  fdhandlein := socket(biniptemp.family,socktype,0);
+  {$ifdef ipv6}
+  if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
+    addr := '0.0.0.0';
+    fdhandlein := socket(AF_INET,socktype,0);
+  end;
+  {$endif}
+  if fdhandlein = -1 then raise ESocketException.create('unable to create socket');
+  dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
+  //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
+  state := wsclosed; // then set this back as it was an undesired side effect of dup
+
+  try
+    yes := $01010101;  {Copied this from existing code. Value is empiric,
+                    but works. (yes=true<>0) }
+    {$ifndef win32}
+      if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
+        raise ESocketException.create('unable to set socket options');
+      end;
+    {$endif}
+    localaddr := addr;
+    localport := port;
+    bindsocket;
+
+    if not udp then begin
+      {!!! allow custom queue length? default 5}
+      if listenqueue = 0 then listenqueue := 5;
+      If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise esocketexception.create('unable to listen');
+      state := wsListening;
+    end else begin
+      {$ifndef win32}
+        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
+      {$endif}
+      state := wsconnected;
+    end;
+  finally
+    if state = wsclosed then begin
+      if fdhandlein >= 0 then begin
+        {one *can* get here without fd -beware}
+        eventcore.rmasterclr(fdhandlein);
+        myfdclose(fdhandlein); // we musnt leak file discriptors
+        eventcore.setfdreverse(fdhandlein,nil);
+        fdhandlein := -1;
+      end;
+    end else begin
+      eventcore.rmasterset(fdhandlein,true);
+    end;
+    if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
+  end;
+  //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); 
+end;
+
+function tlsocket.accept : longint;
+var
+  FromAddrSize     : LongInt;        // i don't realy know what to do with these at this
+  FromAddr         : TInetSockAddrV;  // at this point time will tell :)
+begin
+
+  FromAddrSize := Sizeof(FromAddr);
+  {$ifdef win32}
+    result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
+  {$else}
+    result := sockets.accept(fdhandlein,fromaddr,fromaddrsize);
+  {$endif}
+  //now we have accepted one request start monitoring for more again
+  eventcore.rmasterset(fdhandlein,true);
+
+  if result = -1 then raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting');
+  if result > absoloutemaxs then begin
+    myfdclose(result);
+    result := -1;
+    raise esocketexception.create('file discriptor out of range');
+  end;
+end;
+
+function tlsocket.sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer;
+var
+  destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute dest;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.sendto(self.fdhandleout,data^,len,0,destx,destlen);
+end;
+
+function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer;
+var
+  srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute src;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen);
+end;
+
+procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
+var
+  tempbuf:array[0..receivebufsize-1] of byte;
+begin
+  //writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger);
+  if (state =wslistening) and readtrigger then begin
+{    debugout('listening socket triggered on read');}
+    eventcore.rmasterclr(fdhandlein);
+    if assigned(onsessionAvailable) then onsessionAvailable(self,0);
+  end;
+  if udp and readtrigger then begin
+    if assigned(ondataAvailable) then ondataAvailable(self,0);
+    {!!!test}
+    exit;
+  end;
+  if (state =wsconnecting) and writetrigger then begin
+    // code for dealing with the reults of a non-blocking connect is
+    // rather complex
+    // if just write is triggered it means connect suceeded
+    // if both read and write are triggered it can mean 2 things
+    // 1: connect ok and data availible
+    // 2: connect fail
+    // to find out which you must read from the socket and look for errors
+    // there if we read successfully we drop through into the code for fireing
+    // the read event
+    if not readtrigger then begin
+      state := wsconnected;
+      if assigned(onsessionconnected) then onsessionconnected(self,0);
+    end else begin
+      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
+      if numread <> -1 then begin
+        state := wsconnected;
+        if assigned(onsessionconnected) then onsessionconnected(self,0);
+        //connectread := true;
+        recvq.add(@tempbuf,numread);
+      end else begin
+        state := wsconnected;
+        if assigned(onsessionconnected) then onsessionconnected(self,{$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
+{        debugout('connect fail');}
+        self.internalclose(0);
+        recvq.del(maxlongint);
+      end;
+      // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
+      // so we drop down into the processing for data availible
+    end;
+    if fdhandlein >= 0 then begin
+      if state = wsconnected then begin
+        eventcore.rmasterset(fdhandlein,false);
+      end else begin
+        eventcore.rmasterclr(fdhandlein);
+      end;
+    end;
+    if fdhandleout >= 0 then begin
+      if sendq.size = 0 then begin
+        //don't clear the bit in fdswmaster if data is in the sendq
+        eventcore.wmasterclr(fdhandleout);
+      end;
+    end;
+
+  end;
+  inherited handlefdtrigger(readtrigger,writetrigger);
+end;
+
+constructor tlsocket.Create(AOwner: TComponent);
+begin
+  inherited create(aowner);
+  closehandles := true;
+end;
+
+
+function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
+var
+  addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.getpeername(self.fdhandlein,addrx,addrlen);
+end;
+
+procedure tlsocket.getxaddrbin(var binip:tbinip);
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  fillchar(addr,sizeof(addr),0);
+
+  {$ifdef win32}
+    winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
+  {$else}
+    sockets.getsocketname(self.fdhandlein,addr,i);
+  {$endif}
+  binip.family := addr.inaddr.family;
+  {$ifdef ipv6}
+  if addr.inaddr6.sin6_family = AF_INET6 then begin
+    binip.ip6 := addr.inaddr6.sin6_addr;
+  end else
+  {$endif}
+  begin
+    binip.ip := addr.inaddr.addr;
+  end;
+  converttov4(binip);
+end;
+
+procedure tlsocket.getpeeraddrbin(var binip:tbinip);
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  fillchar(addr,sizeof(addr),0);
+  {$ifdef win32}
+    winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
+  {$else}
+    sockets.getpeername(self.fdhandlein,addr,i);
+  {$endif}
+
+  binip.family := addr.inaddr.family;
+  {$ifdef ipv6}
+  if addr.inaddr6.sin6_family = AF_INET6 then begin
+    binip.ip6 := addr.inaddr6.sin6_addr;
+  end else
+  {$endif}
+  begin
+    binip.ip := addr.inaddr.addr;
+  end;
+  converttov4(binip);
+end;
+
+function tlsocket.getXaddr:string;
+var
+  biniptemp:tbinip;
+begin
+  getxaddrbin(biniptemp);
+  result := ipbintostr(biniptemp);
+  if result = '' then result := 'error';
+end;
+
+function tlsocket.getpeeraddr:string;
+var
+  biniptemp:tbinip;
+begin
+  getpeeraddrbin(biniptemp);
+  result := ipbintostr(biniptemp);
+  if result = '' then result := 'error';
+end;
+
+function tlsocket.getXport:string;
+var
+  addr:{$ifdef win32}winsock.tsockaddr{$else}tinetsockaddr{$endif};
+  i:integer;
+begin
+  i := sizeof(addr);
+  {$ifdef win32}
+    winsock.getsockname(self.fdhandlein,addr,i);
+    i := htons(addr.sin_port);
+  {$else}
+    sockets.getsocketname(self.fdhandlein,addr,i);
+    i := htons(addr.port);
+  {$endif}
+  result := inttostr(i);
+end;
+
+function tlsocket.getpeerport:string;
+var
+  addr:{$ifdef win32}winsock.tsockaddr{$else}tinetsockaddr{$endif};
+  i:integer;
+begin
+  i := sizeof(addr);
+  {$ifdef win32}
+    winsock.getpeername(self.fdhandlein,addr,i);
+    i := htons(addr.sin_port);
+  {$else}
+    sockets.getpeername(self.fdhandlein,addr,i);
+    i := htons(addr.port);
+  {$endif}
+  result := inttostr(i);
+end;
+
+{$ifdef win32}
+  procedure tlsocket.myfdclose(fd : integer);
+  begin
+    closesocket(fd);
+  end;
+  function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
+  begin
+    result := winsock.send(fd,(@buf)^,size,0);
+  end;
+  function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
+  begin
+    result := winsock.recv(fd,buf,size,0);
+  end;
+{$endif}
+
+end.
+
diff --git a/httpserver_20080306/ltimevalstuff.inc b/httpserver_20080306/ltimevalstuff.inc
new file mode 100755
index 0000000..0ac92cb
--- /dev/null
+++ b/httpserver_20080306/ltimevalstuff.inc
@@ -0,0 +1,42 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+
+
+{add nn msec to tv}
+const
+  tv_invalidtimebig : ttimeval = (tv_sec:maxlongint;tv_usec:maxlongint);
+  //tv_invalidtimebig will always compare as greater than any valid timeval
+procedure tv_add(var tv:ttimeval;msec:integer);//{ $ifdef fpc}inline;{ $endif}
+begin
+  inc(tv.tv_usec,msec*1000);
+  inc(tv.tv_sec,tv.tv_usec div 1000000);
+  tv.tv_usec := tv.tv_usec mod 1000000;
+end;
+
+{tv1 >= tv2}
+function tv_compare(const tv1,tv2:ttimeval):boolean;//{ $ifdef fpc}inline;{ $endif}
+begin
+  if tv1.tv_sec = tv2.tv_sec then begin
+    result := tv1.tv_usec >= tv2.tv_usec;
+  end else result := tv1.tv_sec > tv2.tv_sec;
+end;
+
+procedure tv_substract(var tv:ttimeval;const tv2:ttimeval);//{ $ifdef fpc}inline;{ $endif}
+begin
+  dec(tv.tv_usec,tv2.tv_usec);
+  if tv.tv_usec < 0 then begin
+    inc(tv.tv_usec,1000000);
+    dec(tv.tv_sec)
+  end;
+  dec(tv.tv_sec,tv2.tv_sec);
+end;
+
+procedure msectotimeval(var tv:ttimeval;msec:integer);
+begin
+  tv.tv_sec := msec div 1000;
+  tv.tv_usec := (msec mod 1000)*1000;
+end;
+
diff --git a/httpserver_20080306/pgtypes.pas b/httpserver_20080306/pgtypes.pas
new file mode 100755
index 0000000..3c48e26
--- /dev/null
+++ b/httpserver_20080306/pgtypes.pas
@@ -0,0 +1,20 @@
+{io core originally for linux bworld}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+unit pgtypes;
+interface
+  type
+    {$ifdef cpu386}{$define i386}{$endif}
+    {$ifdef i386}
+      taddrint=longint;
+    {$else}
+      taddrint=sizeint;
+    {$endif}
+    paddrint=^taddrint;
+
+implementation
+end.
diff --git a/httpserver_20080306/uint32.inc b/httpserver_20080306/uint32.inc
new file mode 100755
index 0000000..897db79
--- /dev/null
+++ b/httpserver_20080306/uint32.inc
@@ -0,0 +1,14 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+type
+  {delphi 3 and before do not have a 32 bits unsigned integer type,
+  but longint has the correct behavior - it doesn't on newer delphi versions}
+  {$ifndef fpc}
+    {$ifdef ver70}{$define pred4}{$endif} {tp7}
+    {$ifdef ver80}{$define pred4}{$endif} {delphi 1}
+    {$ifdef ver90}{$define pred4}{$endif} {delphi 2}
+    {$ifdef ver100}{$define pred4}{$endif} {delphi 3}
+  {$endif}
+  uint32={$ifdef pred4}longint{$else}longword{$endif};
diff --git a/httpserver_20080306/unixstuff.inc b/httpserver_20080306/unixstuff.inc
new file mode 100755
index 0000000..92ed308
--- /dev/null
+++ b/httpserver_20080306/unixstuff.inc
@@ -0,0 +1,66 @@
+{$ifdef UNIX}
+  {$macro on}
+  {$ifdef VER1_0}
+    {$define tv_sec := sec}
+    {$define tv_usec := usec}
+    function dup(const original:integer):integer;inline;
+    begin
+      linux.dup(original,result);
+    end;
+    {$define gettimeofdaysec := gettimeofday}
+  {$else}
+    
+    {$define sigprocmask := fpsigprocmask}
+    {$define sigaction   := fpsigaction}
+    {$define fdclose     := fpclose}
+    {$define fcntl       := fpfcntl}
+    {$define fdwrite     := fpwrite}
+    {$define fdread      := fpread}
+    {$define fdopen      := fpopen}
+    {$define select      := fpselect}
+    {$define linuxerror  := fpgeterrno}
+    {$define fork        := fpfork}
+    {$define getpid      := fpgetpid}
+    {$define getenv      := fpgetenv}
+    {$define chmod       := fpchmod}
+    {$define dup2        := fpdup2}
+    {$ifndef ver1_9_2}
+      {$define flock       := fpflock}
+    {$endif}
+    procedure gettimeofday(var tv:ttimeval);inline;
+    begin
+      fpgettimeofday(@tv,nil);    
+    end;
+    function gettimeofdaysec : longint;
+    var
+      tv:ttimeval;
+    begin
+      gettimeofday(tv);
+      result := tv.tv_sec;
+    end;
+
+    //a function is used here rather than a define to prevent issues with tlasio.dup
+    function dup(const original:integer):integer;inline;
+    begin
+      result := fpdup(original);
+    end;
+    function octal(invalue:longint):longint;
+    var
+      a : integer;
+      i : integer;
+    begin
+      i := 0;
+      result := 0;
+      while invalue <> 0 do begin
+        a := invalue mod 10;
+        result := result + (a shl (i*3));
+
+        invalue := invalue div 10;
+        inc(i);
+      end;
+    end;
+    const
+      sys_eintr=esyseintr;
+
+  {$endif}
+{$endif}
diff --git a/httpserver_20080306/wcore.pas b/httpserver_20080306/wcore.pas
new file mode 100755
index 0000000..40505ef
--- /dev/null
+++ b/httpserver_20080306/wcore.pas
@@ -0,0 +1,372 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+unit wcore;
+
+{
+lcore compatible interface for windows
+
+- messageloop
+
+- tltimer
+
+}
+//note: events after release are normal and are the apps responsibility to deal with safely
+interface
+
+  uses
+    classes,windows,mmsystem;
+
+  type
+    float=double;
+
+    tlcomponent = class(tcomponent)
+    public
+      released:boolean;
+      procedure release;
+      destructor destroy; override;
+    end;
+
+    tltimer=class(tlcomponent)
+    public
+      ontimer:tnotifyevent;
+      initialevent:boolean;
+      initialdone:boolean;
+      prevtimer:tltimer;
+      nexttimer:tltimer;
+      interval:integer;        {miliseconds, default 1000}
+      enabled:boolean;
+      nextts:integer;
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+    end;
+
+    ttaskevent=procedure(wparam,lparam:longint) of object;
+
+    tltask=class(tobject)
+    public
+      handler  : ttaskevent;
+      obj      : tobject;
+      wparam   : longint;
+      lparam   : longint;
+      nexttask : tltask;
+      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+    end;
+
+procedure messageloop;
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+procedure disconnecttasks(aobj:tobject);
+procedure exitmessageloop;
+procedure processmessages;
+
+var
+  onshutdown:procedure(s:string);
+
+implementation
+
+uses
+  {$ifdef fpc}
+  bmessages;
+  {$else}
+  messages;
+  {$endif}
+
+
+const
+  WINMSG_TASK=WM_USER;
+
+var
+  hwndwcore:hwnd;
+  firsttimer:tltimer;
+  timesubstract:integer;
+  firsttask,lasttask,currenttask:tltask;
+
+procedure tlcomponent.release;
+begin
+  released := true;
+end;
+
+destructor tlcomponent.destroy;
+begin
+  disconnecttasks(self);
+  inherited destroy;
+end;
+
+{------------------------------------------------------------------------------}
+
+constructor tltimer.create;
+begin
+  inherited create(AOwner);
+  nexttimer := firsttimer;
+  prevtimer := nil;
+
+  if assigned(nexttimer) then nexttimer.prevtimer := self;
+  firsttimer := self;
+
+  interval := 1000;
+  enabled := true;
+  released := false;
+end;
+
+destructor tltimer.destroy;
+begin
+  if prevtimer <> nil then begin
+    prevtimer.nexttimer := nexttimer;
+  end else begin
+    firsttimer := nexttimer;
+  end;
+  if nexttimer <> nil then begin
+    nexttimer.prevtimer := prevtimer;
+  end;
+  inherited destroy;
+end;
+
+{------------------------------------------------------------------------------}
+
+function wcore_timehandler:integer;
+const
+  rollover_bits=30;
+var
+  tv,tvnow:integer;
+  currenttimer,temptimer:tltimer;
+begin
+  if not assigned(firsttimer) then begin
+    result := 1000;
+    exit;
+  end;
+
+  tvnow := timegettime;
+  if (tvnow and ((-1) shl rollover_bits)) <> timesubstract then begin
+    currenttimer := firsttimer;
+    while assigned(currenttimer) do begin
+      dec(currenttimer.nextts,(1 shl rollover_bits));
+      currenttimer := currenttimer.nexttimer;
+    end;
+    timesubstract := tvnow and ((-1) shl rollover_bits);
+  end;
+  tvnow := tvnow and ((1 shl rollover_bits)-1);
+
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    if tvnow >= currenttimer.nextts then begin
+      if assigned(currenttimer.ontimer) then begin
+        if currenttimer.enabled then begin
+          if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
+          currenttimer.initialdone := true;
+        end;
+      end;
+      currenttimer.nextts := tvnow+currenttimer.interval;
+    end;
+    temptimer := currenttimer;
+    currenttimer := currenttimer.nexttimer;
+    if temptimer.released then temptimer.free;
+  end;
+
+  tv := maxlongint;
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    if currenttimer.nextts < tv then tv := currenttimer.nextts;
+    currenttimer := currenttimer.nexttimer;
+  end;
+  result := tv-tvnow;
+  if result < 15 then result := 15;
+end;
+
+{------------------------------------------------------------------------------}
+
+constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  inherited create;
+  handler   := ahandler;
+  obj       := aobj;
+  wparam    := awparam;
+  lparam    := alparam;
+  {nexttask  := firsttask;
+  firsttask := self;}
+  if assigned(lasttask) then begin
+    lasttask.nexttask := self;
+  end else begin
+    firsttask := self;
+    postmessage(hwndwcore,WINMSG_TASK,0,0);
+  end;
+  lasttask := self;
+  //ahandler(wparam,lparam);
+end;
+
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  tltask.create(ahandler,aobj,awparam,alparam);
+end;
+
+procedure disconnecttasks(aobj:tobject);
+var
+  currenttasklocal : tltask ;
+  counter          : byte   ;
+begin
+  for counter := 0 to 1 do begin
+    if counter = 0 then begin
+      currenttasklocal := firsttask; //main list of tasks
+    end else begin
+      currenttasklocal := currenttask; //needed in case called from a task
+    end;
+    // note i don't bother to sestroy the links here as that will happen when
+    // the list of tasks is processed anyway
+    while assigned(currenttasklocal) do begin
+      if currenttasklocal.obj = aobj then begin
+        currenttasklocal.obj := nil;
+        currenttasklocal.handler := nil;
+      end;
+      currenttasklocal := currenttasklocal.nexttask;
+    end;
+  end;
+end;
+
+procedure dotasks;
+var
+  temptask:tltask;
+begin
+  if firsttask = nil then exit;
+
+  currenttask := firsttask;
+  firsttask := nil;
+  lasttask  := nil;
+  while assigned(currenttask) do begin
+    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
+    temptask := currenttask;
+    currenttask := currenttask.nexttask;
+    temptask.free;
+  end;
+  currenttask := nil;
+end;
+
+{------------------------------------------------------------------------------}
+
+procedure exitmessageloop;
+begin
+  postmessage(hwndwcore,WM_QUIT,0,0);
+end;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+const timerid_wcore=$1000;
+  {$endif}
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+    MsgRec : TMessage;
+    a:integer;
+begin
+  Result := 0;  // This means we handled the message
+
+  {MsgRec.hwnd    := ahWnd;}
+  MsgRec.wParam  := awParam;
+  MsgRec.lParam  := alParam;
+
+  dotasks;
+  case auMsg of
+    {$ifndef threadtimer}
+    WM_TIMER: begin
+      if msgrec.wparam = timerid_wcore then begin
+        a := wcore_timehandler;
+        killtimer(hwndwcore,timerid_wcore);
+        settimer(hwndwcore,timerid_wcore,a,nil);
+      end;
+    end;
+    {$endif}
+
+    {WINMSG_TASK:dotasks;}
+
+    WM_CLOSE: begin
+      {}
+    end;
+    WM_DESTROY: begin
+      {}
+    end;
+  else
+      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+end;
+
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'wcoreClass');
+
+procedure messageloop;
+var
+  MsgRec : TMsg;
+begin
+
+  if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create wcore handle, hinstance=',hinstance);
+  hwndwcore := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+
+  if hwndwcore = 0 then halt;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+  if settimer(hwndwcore,timerid_wcore,15,nil) = 0 then halt;
+  {$endif}
+
+
+  while GetMessage(MsgRec, 0, 0, 0) do begin
+    TranslateMessage(MsgRec);
+    DispatchMessage(MsgRec);
+    {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}
+  end;
+
+  if hWndwcore <> 0 then begin
+    DestroyWindow(hwndwcore);
+    hWndwcore := 0;
+  end;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+  killtimer(hwndwcore,timerid_wcore);
+  {$endif}
+end;
+
+function ProcessMessage : Boolean;
+var
+    Msg : TMsg;
+begin
+    Result := FALSE;
+    if PeekMessage(Msg, hwndwcore, 0, 0, PM_REMOVE) then begin
+      Result := TRUE;
+      DispatchMessage(Msg);
+    end;
+end;
+
+procedure processmessages;
+begin
+  while processmessage do;
+end;
+
+
+end.
diff --git a/lcore.pas b/lcore.pas
new file mode 100755
index 0000000..900bc96
--- /dev/null
+++ b/lcore.pas
@@ -0,0 +1,891 @@
+{lsocket.pas}
+
+{io and timer code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+{note: you must use the @ in the last param to tltask.create not doing so will
+ compile without error but will cause an access violation -pg}
+
+//note: events after release are normal and are the apps responsibility to deal with safely
+
+unit lcore;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$ifdef win32}
+  {$define nosignal}
+{$endif}
+interface
+  uses
+    sysutils,
+    {$ifndef win32}
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,unixutil,
+      {$endif}
+      fd_utils,
+    {$endif}
+    classes,pgtypes,bfifo;
+  procedure processtasks;
+
+
+  const
+    receivebufsize=1460;
+
+  type
+    {$ifdef ver1_0}
+      sigset= array[0..31] of longint;
+    {$endif}
+
+    ESocketException   = class(Exception);
+    TBgExceptionEvent  = procedure (Sender : TObject;
+                                  E : Exception;
+                                  var CanClose : Boolean) of object;
+
+    // note : tsocketstate is defined in the same way as it is in François PIETTE's twsocket
+    // however tlsocket currently only uses wsClosed wsConnecting wsconnected and wsListening
+    TSocketState       = (wsInvalidState,
+                        wsOpened,     wsBound,
+                        wsConnecting, wsConnected,
+                        wsAccepting,  wsListening,
+                        wsClosed);
+
+    TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay);
+    TWSocketOptions      = set of TWSocketOption;
+
+    TSocketevent     = procedure(Sender: TObject; Error: word) of object;
+    //Tdataavailevent  = procedure(data : string);
+    TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;
+
+    tlcomponent = class(tcomponent)
+    public
+      released:boolean;
+      procedure release; virtual;
+      destructor destroy; override;
+    end;
+
+    tlasio = class(tlcomponent)
+    public
+      state              : tsocketstate      ;
+      ComponentOptions   : TWSocketOptions;
+      fdhandlein         : Longint           ;  {file discriptor}
+      fdhandleout        : Longint           ;  {file discriptor}
+
+      onsessionclosed    : tsocketevent      ;
+      ondataAvailable    : tsocketevent      ;
+      onsessionAvailable : tsocketevent      ;
+
+      onsessionconnected : tsocketevent      ;
+      onsenddata         : tsenddata      ;
+      ondatasent         : tsocketevent      ;
+      //connected          : boolean         ;
+      nextasin           : tlasio            ;
+      prevasin           : tlasio            ;
+
+      recvq              : tfifo;
+      OnBgException      : TBgExceptionEvent ;
+      //connectread        : boolean           ;
+      sendq              : tfifo;
+      closehandles       : boolean           ;
+      writtenthiscycle   : boolean           ;
+      onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd
+      lasterror:integer;
+      destroying:boolean;
+      function receivestr:string; virtual;
+      procedure close;
+      procedure abort;
+      procedure internalclose(error:word); virtual;
+      constructor Create(AOwner: TComponent); override;
+
+      destructor destroy; override;
+      procedure fdcleanup;
+      procedure HandleBackGroundException(E: Exception);
+      procedure handlefdtrigger(readtrigger,writetrigger:boolean); virtual;
+      procedure dup(invalue:longint);
+
+      function sendflush : integer;
+      procedure sendstr(const str : string);virtual;
+      procedure putstringinsendbuffer(const newstring : string);
+      function send(data:pointer;len:integer):integer;virtual;
+      procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
+      procedure deletebuffereddata;
+
+      //procedure messageloop;
+      function Receive(Buf:Pointer;BufSize:integer):integer; virtual;
+      procedure flush;virtual;{$ifdef win32} abstract;{$endif}
+      procedure dodatasent(wparam,lparam:longint);
+      procedure doreceiveloop(wparam,lparam:longint);
+      procedure sinkdata(sender:tobject;error:word);
+
+      procedure release; override; {test -beware}
+
+      function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
+
+      procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif}
+      function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
+      function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}
+    protected
+      procedure dupnowatch(invalue:longint);
+    end;
+    ttimerwrapperinterface=class(tlcomponent)
+    public
+      function createwrappedtimer : tobject;virtual;abstract;
+//      procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
+      procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);virtual;abstract;
+      procedure setenabled(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
+      procedure setinterval(wrappedtimer : tobject;newvalue : integer);virtual;abstract;
+    end;
+
+  var
+    timerwrapperinterface : ttimerwrapperinterface;
+  type
+    {$ifdef win32}
+      ttimeval = record
+        tv_sec : longint;
+        tv_usec : longint;
+      end;
+    {$endif}
+    tltimer=class(tlcomponent)
+    protected
+
+
+      wrappedtimer : tobject;
+
+
+//      finitialevent       : boolean           ;
+      fontimer            : tnotifyevent      ;
+      fenabled            : boolean           ;
+      finterval	          : integer	     ; {miliseconds, default 1000}
+      {$ifndef win32}
+        procedure resettimes;
+      {$endif}
+//      procedure setinitialevent(newvalue : boolean);
+      procedure setontimer(newvalue:tnotifyevent);
+      procedure setenabled(newvalue : boolean);
+      procedure setinterval(newvalue : integer);
+    public
+      //making theese public for now, this code should probablly be restructured later though
+      prevtimer          : tltimer           ;
+      nexttimer          : tltimer           ;
+      nextts	         : ttimeval          ;
+
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+//      property initialevent : boolean read finitialevent write setinitialevent;
+      property ontimer : tnotifyevent read fontimer write setontimer;
+      property enabled : boolean read fenabled write setenabled;
+      property interval	: integer read finterval write setinterval;
+
+    end;
+
+    ttaskevent=procedure(wparam,lparam:longint) of object;
+
+    tltask=class(tobject)
+    public
+      handler  : ttaskevent;
+      obj      : tobject;
+      wparam   : longint;
+      lparam   : longint;
+      nexttask : tltask;
+      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+    end;
+
+
+
+    teventcore=class
+    public
+      procedure processmessages; virtual;abstract;
+      procedure messageloop; virtual;abstract;
+      procedure exitmessageloop; virtual;abstract;
+      procedure setfdreverse(fd : integer;reverseto : tlasio);virtual;abstract;
+      procedure rmasterset(fd : integer;islistensocket : boolean);  virtual;abstract;
+      procedure rmasterclr(fd: integer);  virtual;abstract;
+      procedure wmasterset(fd : integer); virtual;abstract;
+      procedure wmasterclr(fd: integer);  virtual;abstract;
+    end;
+var
+    eventcore : teventcore;
+
+procedure processmessages;
+procedure messageloop;
+procedure exitmessageloop;
+
+var
+  firstasin                             : tlasio     ;
+  firsttimer                            : tltimer    ;
+  firsttask  , lasttask   , currenttask : tltask     ;
+
+  numread                               : integer    ;
+  mustrefreshfds                        : boolean    ;
+{  lcoretestcount:integer;}
+
+  asinreleaseflag:boolean;
+
+
+procedure disconnecttasks(aobj:tobject);
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+type
+  tonaddtask = procedure(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+var
+  onaddtask : tonaddtask;
+
+
+procedure sleep(i:integer);
+{$ifndef nosignal}
+  procedure prepsigpipe;{$ifndef ver1_0}inline;{$endif}
+{$endif}
+
+
+implementation
+{$ifndef nosignal}
+  uses {sockets,}lloopback,lsignal;
+{$endif}
+{$ifdef win32}
+  uses windows,winsock;
+{$endif}
+{$ifndef win32}
+  {$include unixstuff.inc}
+{$endif}
+{$include ltimevalstuff.inc}
+
+
+{!!! added sleep call -beware}
+procedure sleep(i:integer);
+var
+  tv:ttimeval;
+begin
+  {$ifdef win32}
+    windows.sleep(i);
+  {$else}
+    tv.tv_sec := i div 1000;
+    tv.tv_usec := (i mod 1000) * 1000;
+    select(0,nil,nil,nil,@tv);
+  {$endif}
+end;
+
+destructor tlcomponent.destroy;
+begin
+  disconnecttasks(self);
+  inherited destroy;
+end;
+
+
+
+
+procedure tlcomponent.release;
+begin
+  released := true;
+end;
+
+procedure tlasio.release;
+begin
+  asinreleaseflag := true;
+  inherited release;
+end;
+
+procedure tlasio.doreceiveloop;
+begin
+  if recvq.size = 0 then exit;
+  if assigned(ondataavailable) then ondataavailable(self,0);
+  if not (wsonoreceiveloop in componentoptions) then
+  if recvq.size > 0 then tltask.create(self.doreceiveloop,self,0,0);
+end;
+
+function tlasio.receivestr;
+begin
+  setlength(result,recvq.size);
+  receive(@result[1],length(result));
+end;
+
+function tlasio.receive(Buf:Pointer;BufSize:integer):integer;
+var
+  i,a,b:integer;
+  p:pointer;
+begin
+  i := bufsize;
+  if recvq.size < i then i := recvq.size;
+  a := 0;
+  while (a < i) do begin
+    b := recvq.get(p,i-a);
+    move(p^,buf^,b);
+    inc(taddrint(buf),b);
+    recvq.del(b);
+    inc(a,b);
+  end;
+  result := i;
+  if wsonoreceiveloop in componentoptions then begin
+    if recvq.size = 0 then eventcore.rmasterset(fdhandlein,false);
+  end;
+end;
+
+constructor tlasio.create;
+begin
+  inherited create(AOwner);
+  sendq := tfifo.create;
+  recvq := tfifo.create;
+  state := wsclosed;
+  fdhandlein := -1;
+  fdhandleout := -1;
+  nextasin := firstasin;
+  prevasin := nil;
+  if assigned(nextasin) then nextasin.prevasin := self;
+  firstasin := self;
+
+  released := false;
+end;
+
+destructor tlasio.destroy;
+begin
+  destroying := true;
+  if state <> wsclosed then close;
+  if prevasin <> nil then begin
+    prevasin.nextasin := nextasin;
+  end else begin
+    firstasin := nextasin;
+  end;
+  if nextasin <> nil then begin
+    nextasin.prevasin := prevasin;
+  end;
+  recvq.destroy;
+  sendq.destroy;
+  inherited destroy;
+end;
+
+procedure tlasio.close;
+begin
+  internalclose(0);
+end;
+
+procedure tlasio.abort;
+begin
+  close;
+end;
+
+procedure tlasio.fdcleanup;
+begin
+  if fdhandlein <> -1 then begin
+    eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster)
+  end;
+  if fdhandleout <> -1 then begin
+    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster)
+  end;
+  if fdhandlein=fdhandleout then begin
+    if fdhandlein <> -1 then begin
+      myfdclose(fdhandlein);
+    end;
+  end else begin
+    if fdhandlein <> -1 then begin
+      myfdclose(fdhandlein);
+    end;
+    if fdhandleout <> -1 then begin
+      myfdclose(fdhandleout);
+    end;
+  end;
+  fdhandlein := -1;
+  fdhandleout := -1;
+end;
+
+procedure tlasio.internalclose(error:word);
+begin
+  if state<>wsclosed then begin
+    if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
+    eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
+    eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+
+    if closehandles then begin
+      {$ifndef win32}
+        //anyone remember why this is here? --plugwash
+        fcntl(fdhandlein,F_SETFL,0);
+      {$endif}
+      myfdclose(fdhandlein);
+      if fdhandleout <> fdhandlein then begin
+        {$ifndef win32}
+          fcntl(fdhandleout,F_SETFL,0);
+        {$endif}
+        myfdclose(fdhandleout);
+      end;
+      eventcore.setfdreverse(fdhandlein,nil);
+      eventcore.setfdreverse(fdhandleout,nil);
+
+      fdhandlein := -1;
+      fdhandleout := -1;
+    end;
+    state := wsclosed;
+
+    if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error);
+  end;
+  sendq.del(maxlongint);
+end;
+
+
+{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
+{ All exceptions *MUST* be handled. If an exception is not handled, the     }
+{ application will most likely be shut down !                               }
+procedure tlasio.HandleBackGroundException(E: Exception);
+var
+  CanAbort : Boolean;
+begin
+  CanAbort := TRUE;
+  { First call the error event handler, if any }
+  if Assigned(OnBgException) then begin
+    try
+      OnBgException(Self, E, CanAbort);
+    except
+    end;
+  end;
+  { Then abort the socket }
+  if CanAbort then begin
+    try
+      close;
+    except
+    end;
+  end;
+end;
+
+procedure tlasio.sendstr(const str : string);
+begin
+  putstringinsendbuffer(str);
+  sendflush;
+end;
+
+procedure tlasio.putstringinsendbuffer(const newstring : string);
+begin
+  if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
+end;
+
+function tlasio.send(data:pointer;len:integer):integer;
+begin
+  if state <> wsconnected then begin
+    result := -1;
+    exit;
+  end;
+  if len < 0 then len := 0;
+  result := len;
+  putdatainsendbuffer(data,len);
+  sendflush;
+end;
+
+
+procedure tlasio.putdatainsendbuffer(data:pointer;len:integer);
+begin
+  sendq.add(data,len);
+end;
+
+function tlasio.sendflush : integer;
+var
+  lensent : integer;
+  data:pointer;
+//  fdstestr : fdset;
+//  fdstestw : fdset;
+begin
+  if state <> wsconnected then exit;
+
+  lensent := sendq.get(data,2920);
+  if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
+
+  if result = -1 then lensent := 0 else lensent := result;
+
+  //sendq := copy(sendq,lensent+1,length(sendq)-lensent);
+  sendq.del(lensent);
+
+  //fd_clr(fdhandleout,fdsw); // this prevents the socket being closed by a write
+                            // that sends nothing because a previous socket has
+                            // slready flushed this socket when the message loop
+                            // reaches it
+//  if sendq.size > 0 then begin
+    eventcore.wmasterset(fdhandleout);//fd_set(fdhandleout,fdswmaster);
+//  end else begin
+//    wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+//  end;
+  if result > 0 then begin
+    if assigned(onsenddata) then onsenddata(self,result);
+//    if sendq.size=0 then if assigned(ondatasent) then begin
+//      tltask.create(self.dodatasent,self,0,0);
+//      //begin test code
+//      fd_zero(fdstestr);
+//      fd_zero(fdstestw);
+//      fd_set(fdhandlein,fdstestr);
+//      fd_set(fdhandleout,fdstestw);
+//      select(maxs,@fdstestr,@fdstestw,nil,0);
+//      writeln(fd_isset(fdhandlein,fdstestr),' ',fd_isset(fdhandleout,fdstestw));
+//      //end test code
+//    
+//    end;
+    writtenthiscycle := true;
+  end;
+end;
+
+procedure tlasio.dupnowatch(invalue:longint);
+begin
+  {  debugout('invalue='+inttostr(invalue));}
+  //readln;
+  if state<> wsclosed then close;
+  fdhandlein := invalue;
+  fdhandleout := invalue;
+  eventcore.setfdreverse(fdhandlein,self);
+  {$ifndef win32}
+    fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
+  {$endif}
+  state := wsconnected;
+
+end;
+
+
+procedure tlasio.dup(invalue:longint);
+begin
+  dupnowatch(invalue);
+  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
+  eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+end;
+
+
+procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
+var
+  sendflushresult : integer;
+  tempbuf:array[0..receivebufsize-1] of byte;
+begin
+  if (state=wsconnected) and writetrigger then begin
+    //writeln('write trigger');
+
+    if (sendq.size >0) then begin
+
+      sendflushresult := sendflush;
+      if (sendflushresult <= 0) and (not writtenthiscycle) then begin
+        if sendflushresult=0 then begin // linuxerror := 0;
+          internalclose(0);
+
+        end else begin
+          internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+        end;
+      end;
+
+    end else begin
+      //everything is sent fire off ondatasent event
+      if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
+      if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0);
+    end;
+    if assigned(onfdwrite) then onfdwrite(self,0);
+  end;
+  writtenthiscycle := false;
+  if (state =wsconnected) and readtrigger then begin
+    if recvq.size=0 then begin
+      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
+      if (numread=0) and (not mustrefreshfds) then begin
+        {if i remember correctly numread=0 is caused by eof
+        if this isn't dealt with then you get a cpu eating infinite loop
+        however if onsessionconencted has called processmessages that could
+        cause us to drop to here with an empty recvq and nothing left to read
+        and we don't want that to cause the socket to close}
+
+        internalclose(0);
+      end else if (numread=-1) then begin
+        {$ifdef win32}
+          //sometimes on windows we get stale messages due to the inherent delays
+          //in the windows message queue
+          if WSAGetLastError = wsaewouldblock then begin
+            //do nothing
+          end else
+        {$endif}
+        begin
+          numread := 0;
+          internalclose({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
+        end;
+      end else if numread > 0 then recvq.add(@tempbuf,numread);
+    end;
+
+    if recvq.size > 0 then begin
+      if wsonoreceiveloop in componentoptions then eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster);
+      if assigned(ondataavailable) then ondataAvailable(self,0);
+      if not (wsonoreceiveloop in componentoptions) then if recvq.size > 0 then
+      tltask.create(self.doreceiveloop,self,0,0);
+    end;
+    //until (numread = 0) or (currentsocket.state<>wsconnected);
+{    debugout('inner loop complete');}
+  end;
+end;
+
+{$ifndef win32}
+  procedure tlasio.flush;
+  var
+    fds : fdset;
+  begin
+    fd_zero(fds);
+    fd_set(fdhandleout,fds);
+    while sendq.size>0 do begin
+      select(fdhandleout+1,nil,@fds,nil,nil);
+      if sendflush <= 0 then exit;
+    end;
+  end;
+{$endif}
+
+procedure tlasio.dodatasent(wparam,lparam:longint);
+begin
+  if assigned(ondatasent) then ondatasent(self,lparam);
+end;
+
+procedure tlasio.deletebuffereddata;
+begin
+  sendq.del(maxlongint);
+end;
+
+procedure tlasio.sinkdata(sender:tobject;error:word);
+begin
+  tlasio(sender).recvq.del(maxlongint);
+end;
+
+{$ifndef win32}
+  procedure tltimer.resettimes;
+  begin
+    gettimeofday(nextts);
+    {if not initialevent then} tv_add(nextts,interval);
+  end;
+{$endif}
+
+{procedure tltimer.setinitialevent(newvalue : boolean);
+begin
+  if newvalue <> finitialevent then begin
+    finitialevent := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setinitialevent(wrappedtimer,newvalue);
+    end else begin
+      resettimes;
+    end;
+  end;
+end;}
+
+procedure tltimer.setontimer(newvalue:tnotifyevent);
+begin
+  if @newvalue <> @fontimer then begin
+    fontimer := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setontimer(wrappedtimer,newvalue);
+    end else begin
+
+    end;
+  end;
+
+end;
+
+
+procedure tltimer.setenabled(newvalue : boolean);
+begin
+  if newvalue <> fenabled then begin
+    fenabled := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setenabled(wrappedtimer,newvalue);
+    end else begin
+      {$ifdef win32}
+        raise exception.create('non wrapper timers are not permitted on windows');
+      {$else}
+        resettimes;
+      {$endif}
+    end;
+  end;
+end;
+
+procedure tltimer.setinterval(newvalue:integer);
+begin
+  if newvalue <> finterval then begin
+    finterval := newvalue;
+    if assigned(timerwrapperinterface) then begin
+      timerwrapperinterface.setinterval(wrappedtimer,newvalue);
+    end else begin
+      {$ifdef win32}
+        raise exception.create('non wrapper timers are not permitted on windows');
+      {$else}
+        resettimes;
+      {$endif}
+    end;
+  end;
+
+end;
+
+
+
+
+constructor tltimer.create;
+begin
+  inherited create(AOwner);
+  if assigned(timerwrapperinterface) then begin
+    wrappedtimer := timerwrapperinterface.createwrappedtimer;
+  end else begin
+
+
+    nexttimer := firsttimer;
+    prevtimer := nil;
+
+    if assigned(nexttimer) then nexttimer.prevtimer := self;
+    firsttimer := self;
+  end;
+  interval := 1000;
+  enabled := true;
+  released := false;
+
+end;
+
+destructor tltimer.destroy;
+begin
+  if assigned(timerwrapperinterface) then begin
+    wrappedtimer.free;
+  end else begin
+    if prevtimer <> nil then begin
+      prevtimer.nexttimer := nexttimer;
+    end else begin
+      firsttimer := nexttimer;
+    end;
+    if nexttimer <> nil then begin
+      nexttimer.prevtimer := prevtimer;
+    end;
+    
+  end;
+  inherited destroy;
+end;
+
+constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  inherited create;
+  if assigned(onaddtask) then onaddtask(ahandler,aobj,awparam,alparam);
+  handler   := ahandler;
+  obj       := aobj;
+  wparam    := awparam;
+  lparam    := alparam;
+  {nexttask  := firsttask;
+  firsttask := self;}
+  if assigned(lasttask) then begin
+    lasttask.nexttask := self;
+  end else begin
+    firsttask := self;
+  end;
+  lasttask := self;
+  //ahandler(wparam,lparam);
+end;
+
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+
+  tltask.create(ahandler,aobj,awparam,alparam);
+end;
+
+{$ifndef nosignal}
+  procedure prepsigpipe;{$ifndef ver1_0}inline;
+{$endif}
+  begin
+    starthandlesignal(sigpipe);
+    if not assigned(signalloopback) then begin
+      signalloopback := tlloopback.create(nil);
+      signalloopback.ondataAvailable := signalloopback.sinkdata;
+
+    end;
+
+  end;
+{$endif}
+
+procedure processtasks;//inline;
+var
+  temptask                : tltask   ;
+
+begin
+
+  if not assigned(currenttask) then begin
+    currenttask := firsttask;
+    firsttask := nil;
+    lasttask  := nil;
+  end;
+  while assigned(currenttask) do begin
+
+    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
+    if assigned(currenttask) then begin
+      temptask := currenttask;
+      currenttask := currenttask.nexttask;
+      temptask.free;
+    end;
+    //writeln('processed a task');
+  end;
+
+end;
+
+
+
+
+procedure disconnecttasks(aobj:tobject);
+var
+  currenttasklocal : tltask ;
+  counter          : byte   ;
+begin
+  for counter := 0 to 1 do begin
+    if counter = 0 then begin
+      currenttasklocal := firsttask; //main list of tasks
+    end else begin
+      currenttasklocal := currenttask; //needed in case called from a task
+    end;
+    // note i don't bother to sestroy the links here as that will happen when
+    // the list of tasks is processed anyway
+    while assigned(currenttasklocal) do begin
+      if currenttasklocal.obj = aobj then begin
+        currenttasklocal.obj := nil;
+        currenttasklocal.handler := nil;
+      end;
+      currenttasklocal := currenttasklocal.nexttask;
+    end;
+  end;
+end;
+
+
+procedure processmessages;
+begin
+  eventcore.processmessages;
+end;
+procedure messageloop;
+begin
+  eventcore.messageloop;
+end;
+
+procedure exitmessageloop;
+begin
+  eventcore.exitmessageloop;
+end;
+
+function tlasio.RealSend(Data : Pointer; Len : Integer) : Integer;
+begin
+  result := myfdwrite(fdhandleout,data^,len);
+  if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
+  eventcore.wmasterset(fdhandleout);
+end;
+{$ifndef win32}
+  procedure tlasio.myfdclose(fd : integer);
+  begin
+    fdclose(fd);
+  end;
+  function tlasio.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
+  begin
+    result := fdwrite(fd,buf,size);
+  end;
+
+  function tlasio.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
+  begin
+    result := fdread(fd,buf,size);
+  end;
+
+
+{$endif}
+
+
+begin
+  firstasin := nil;
+  firsttask := nil;
+  
+
+  {$ifndef nosignal}
+    signalloopback := nil;
+  {$endif}
+end.
+
+
+
+
+
diff --git a/lcoregtklaz.pas b/lcoregtklaz.pas
new file mode 100755
index 0000000..bbf4418
--- /dev/null
+++ b/lcoregtklaz.pas
@@ -0,0 +1,142 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+      
+unit lcoregtklaz;
+{$mode delphi}
+interface
+	
+uses baseunix,unix,glib, gdk, gtk,lcore,forms,fd_utils,classes;
+//procedure lcoregtklazrun;
+const
+  G_IO_IN=1;
+  G_IO_OUT=4;
+  G_IO_PRI=2;
+  G_IO_ERR=8;
+
+  G_IO_HUP=16;
+  G_IO_NVAL=32;
+type
+  tlaztimerwrapperinterface=class(ttimerwrapperinterface)
+  public
+    function createwrappedtimer : tobject;override;
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;
+  end;
+
+procedure lcoregtklazinit;
+implementation
+  uses
+    ExtCtrls;
+{$I unixstuff.inc}
+var
+  giochannels : array[0..absoloutemaxs] of pgiochannel;
+
+function iocallback(source:PGIOChannel; condition:TGIOCondition; data:gpointer):gboolean;cdecl;
+// return true if we want the callback to stay
+var
+  fd                    : integer ;
+  fdsrlocal , fdswlocal : fdset   ;
+  currentasio           : tlasio  ;
+begin
+  fd := g_io_channel_unix_get_fd(source);
+  fd_zero(fdsrlocal);
+  fd_set(fd,fdsrlocal);
+  fdswlocal := fdsrlocal;
+  select(fd+1,@fdsrlocal,@fdswlocal,nil,0);
+  if fd_isset(fd,fdsrlocal) or fd_isset(fd,fdsrlocal) then begin
+    currentasio := fdreverse[fd];
+    if assigned(currentasio) then begin
+      currentasio.handlefdtrigger(fd_isset(currentasio.fdhandlein,fdsrlocal),fd_isset(currentasio.fdhandleout,fdswlocal));
+    end else begin
+      rmasterclr(fd);
+      wmasterclr(fd);
+    end;
+  end;
+  case condition of
+    G_IO_IN : begin
+      result := rmasterisset(fd);
+    end;
+    G_IO_OUT : begin
+      result := wmasterisset(fd);
+    end;
+  end;
+end;
+
+procedure gtkrmasterset(fd : integer);
+begin
+  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
+  g_io_add_watch(giochannels[fd],G_IO_IN,iocallback,nil);
+end;
+
+procedure gtkrmasterclr(fd: integer);
+begin
+end;
+  
+procedure gtkwmasterset(fd : integer);
+begin
+  if not assigned(giochannels[fd]) then giochannels[fd] := g_io_channel_unix_new(fd);
+  g_io_add_watch(giochannels[fd],G_IO_OUT,iocallback,nil);
+end;
+
+procedure gtkwmasterclr(fd: integer);
+begin
+end;
+
+type
+  tsc = class
+    procedure dotasksandsink(sender:tobject;error:word);
+  end;
+var
+  taskloopback : tlloopback;
+  sc           : tsc;
+procedure tsc.dotasksandsink(sender:tobject;error:word);
+begin
+  with tlasio(sender) do begin
+    sinkdata(sender,error);
+    processtasks;
+  end;
+end;
+procedure gtkaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  taskloopback.sendstr(' ');
+  
+end;
+
+procedure lcoregtklazinit;
+begin
+  onrmasterset := gtkrmasterset;
+  onrmasterclr := gtkrmasterclr;
+  onwmasterset := gtkwmasterset;
+  onwmasterclr := gtkwmasterclr;
+  onaddtask := gtkaddtask;
+  taskloopback := tlloopback.create(nil);
+  taskloopback.ondataavailable := sc.dotasksandsink;
+  timerwrapperinterface := tlaztimerwrapperinterface.create(nil);
+end;
+
+function tlaztimerwrapperinterface.createwrappedtimer : tobject;
+begin
+  result := ttimer.create(nil);
+end;
+procedure tlaztimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);
+begin
+  ttimer(wrappedtimer).ontimer := newvalue;
+end;
+procedure tlaztimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);
+begin
+  ttimer(wrappedtimer).enabled := newvalue;
+end;
+
+
+procedure tlaztimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);
+begin
+  ttimer(wrappedtimer).interval := newvalue;
+end;
+
+
+end.
+
diff --git a/lcoreselect.pas b/lcoreselect.pas
new file mode 100755
index 0000000..e0351eb
--- /dev/null
+++ b/lcoreselect.pas
@@ -0,0 +1,399 @@
+{lsocket.pas}
+
+{io and timer code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+{$ifdef fpc}                                                                    
+  {$ifndef ver1_0}                                                              
+    {$define useinline}                                                         
+  {$endif}                                                                      
+{$endif}  
+
+unit lcoreselect;
+
+
+interface
+uses
+  {$ifdef VER1_0}
+    linux,
+  {$else}
+    baseunix,unix,unixutil,
+  {$endif}
+  fd_utils;
+var
+  maxs                                  : longint    ;
+  exitloopflag                          : boolean    ; {if set by app, exit mainloop}
+
+function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}
+function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}
+
+implementation
+uses
+  lcore,sysutils,
+  classes,pgtypes,bfifo,
+  {$ifndef nosignal}
+    lsignal;
+  {$endif}
+
+{$include unixstuff.inc}
+{$include ltimevalstuff.inc}
+var
+  fdreverse:array[0..absoloutemaxs] of tlasio;
+type
+  tselecteventcore=class(teventcore)
+    public
+      procedure processmessages; override;
+      procedure messageloop; override;
+      procedure exitmessageloop;override;
+      procedure setfdreverse(fd : integer;reverseto : tlasio); override;
+      procedure rmasterset(fd : integer;islistensocket : boolean); override;
+      procedure rmasterclr(fd: integer); override;
+      procedure wmasterset(fd : integer); override;
+      procedure wmasterclr(fd: integer); override;
+    end;
+
+procedure processtimers;inline;
+var
+  tv           ,tvnow     : ttimeval ;
+  currenttimer            : tltimer   ;
+  temptimer               : tltimer  ;
+
+begin
+  gettimeofday(tvnow);
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    //writeln(currenttimer.enabled);
+    if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
+      //if assigned(currenttimer.ontimer) then begin
+      //  if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
+      //  currenttimer.initialdone := true;
+      //end;
+      if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
+      currenttimer.nextts := timeval(tvnow);
+      tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
+    end;
+    temptimer := currenttimer;
+    currenttimer := currenttimer.nexttimer;
+    if temptimer.released then temptimer.free;
+  end;
+end;
+
+procedure processasios(var fdsr,fdsw:fdset);//inline;
+var
+  currentsocket : tlasio  ;
+  tempsocket    : tlasio  ;
+  socketcount   : integer ; // for debugging perposes :)
+  dw,bt:integer;
+begin
+{  inc(lcoretestcount);}
+
+    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
+    //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
+
+
+  {------- test optimised loop}
+  socketcount := 0;
+  for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
+    for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin
+      inc(socketcount);
+      currentsocket := fdreverse[dw shl 5 or bt];
+      {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
+      if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
+      {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
+      if not assigned(currentsocket) then begin
+        fdclose(dw shl 5 or bt);
+        continue
+      end;
+      if currentsocket.fdhandlein < 0 then begin
+        fdclose(dw shl 5 or bt);
+        continue
+      end;
+      try
+        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
+      except
+        on E: exception do begin
+          currentsocket.HandleBackGroundException(e);
+        end;
+      end;
+
+      if mustrefreshfds then begin
+        if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
+          fd_zero(fdsr);
+          fd_zero(fdsw);
+        end;
+      end;
+    end;
+  end;
+
+  if asinreleaseflag then begin
+    asinreleaseflag := false;
+    currentsocket := firstasin;
+    while assigned(currentsocket) do begin
+      tempsocket := currentsocket;
+      currentsocket := currentsocket.nextasin;
+      if tempsocket.released then begin
+        tempsocket.free;
+      end;
+    end;
+  end;
+  {
+  !!! issues:
+  - sockets which are released may not be freed because theyre never processed by the loop
+  made new code for handling this, using asinreleaseflag
+
+  - when/why does the mustrefreshfds select apply, sheck if i did it correctly?
+
+  - what happens if calling handlefdtrigger for a socket which does not have an event
+  }
+  {------- original loop}
+
+  (*
+  currentsocket := firstasin;
+  socketcount := 0;
+  while assigned(currentsocket) do begin
+    if mustrefreshfds then begin
+      if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
+        fd_zero(fdsr);
+        fd_zero(fdsw);
+      end;
+    end;
+    try
+      if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
+        currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
+      end;
+    except
+      on E: exception do begin
+        currentsocket.HandleBackGroundException(e);
+      end;
+    end;
+    tempsocket := currentsocket;
+    currentsocket := currentsocket.nextasin;
+    inc(socketcount);
+    if tempsocket.released then begin
+      tempsocket.free;
+    end;
+  end; *)
+{  debugout('socketcount='+inttostr(socketcount));}
+end;
+
+procedure tselecteventcore.processmessages;
+var
+  fdsr         , fdsw : fdset   ;
+  selectresult        : longint ;
+begin
+  mustrefreshfds := false;
+  {$ifndef nosignal}
+    prepsigpipe;
+  {$endif}
+  selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
+  while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
+
+    processtasks;
+    processtimers;
+    if selectresult > 0 then begin
+      processasios(fdsr,fdsw);
+    end;
+    selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
+
+  end;
+  mustrefreshfds := true;
+end;
+
+
+var
+  FDSR , FDSW : fdset;
+
+var
+  fdsrmaster , fdswmaster               : fdset      ;
+
+function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
+begin
+  result := fdsrmaster;
+end;
+function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
+begin
+  result := fdswmaster;
+end;
+
+
+Function  doSelect(timeOut:PTimeVal):longint;//inline;
+var
+  localtimeval : ttimeval;
+  maxslocal    : integer;
+begin
+  //unblock signals
+  //zeromemory(@sset,sizeof(sset));
+  //sset[0] := ;
+  fdsr := getfdsrmaster;
+  fdsw := getfdswmaster;
+
+  if assigned(firsttask) then begin
+    localtimeval.tv_sec  := 0;
+    localtimeval.tv_usec := 0;
+    timeout := @localtimeval;
+  end;
+
+  maxslocal := maxs;
+  mustrefreshfds := false;
+{  debugout('about to call select');}
+  {$ifndef nosignal}
+    sigprocmask(SIG_UNBLOCK,@blockset,nil);
+  {$endif}
+  result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
+  if result <= 0 then begin
+    fd_zero(FDSR);
+    fd_zero(FDSW);
+    if result=-1 then begin
+      if linuxerror = SYS_EINTR then begin
+        // we received a signal it's not a problem
+      end else begin
+        raise esocketexception.create('select returned error '+inttostr(linuxerror));
+      end;
+    end;
+  end;
+  {$ifndef nosignal}
+    sigprocmask(SIG_BLOCK,@blockset,nil);
+  {$endif}
+{  debugout('select complete');}
+end;
+
+procedure tselecteventcore.exitmessageloop;
+begin
+  exitloopflag := true
+end;
+
+
+
+procedure tselecteventcore.messageloop;
+var
+  tv           ,tvnow     : ttimeval ;
+  currenttimer            : tltimer  ;
+  selectresult:integer;
+begin
+  {$ifndef nosignal}
+    prepsigpipe;
+  {$endif}
+  {currentsocket := firstasin;
+  if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
+  repeat
+
+    if currentsocket.state = wsconnected then currentsocket.sendflush;
+    currentsocket := currentsocket.nextasin;
+  until not assigned(currentsocket);}
+
+
+  repeat
+
+    //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
+    if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;
+    {fd_zero(FDSR);
+    fd_zero(FDSW);
+    currentsocket := firstasin;
+    if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
+
+    repeat
+      if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);
+      if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);
+      if currentsocket is tlsocket then begin
+         if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);
+      end;
+      tempsocket := currentsocket;
+      currentsocket := currentsocket.nextasin;
+      if tempsocket.released then begin
+        tempsocket.free;
+      end;
+    until not assigned(currentsocket);
+    }
+    processtasks;
+    //currenttask := nil;
+    {beware}
+    //if assigned(firsttimer) then begin
+    //  tv.tv_sec := maxlongint;
+    tv := tv_invalidtimebig;
+    currenttimer := firsttimer;
+    while assigned(currenttimer) do begin
+      if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
+      currenttimer := currenttimer.nexttimer;
+    end;
+
+
+    if tv_compare(tv,tv_invalidtimebig) then begin    
+      //writeln('no timers active');
+      if exitloopflag then break;
+{    sleep(10);}
+      selectresult := doselect(nil);
+
+    end else begin
+      gettimeofday(tvnow);
+      tv_substract(tv,tvnow);
+
+      //writeln('timers active');
+      if tv.tv_sec < 0 then begin
+        tv.tv_sec := 0;
+        tv.tv_usec := 0; {0.1 sec}
+      end;
+      if exitloopflag then break;
+{    sleep(10);}
+      selectresult := doselect(@tv);
+      processtimers;
+
+    end;
+    if selectresult > 0 then processasios(fdsr,fdsw);
+    {!!!only call processasios if select has asio events -beware}
+
+    {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
+  until false;
+end;
+
+
+procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
+begin
+  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
+  if fd > maxs then maxs := fd;
+  if fd_isset(fd,fdsrmaster) then exit;
+  fd_set(fd,fdsrmaster);
+
+end;
+
+procedure tselecteventcore.rmasterclr(fd: integer);
+begin
+  if not fd_isset(fd,fdsrmaster) then exit;
+  fd_clr(fd,fdsrmaster);
+
+end;
+
+
+procedure tselecteventcore.wmasterset(fd : integer);
+begin
+  if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
+  if fd > maxs then maxs := fd;
+
+  if fd_isset(fd,fdswmaster) then exit;
+  fd_set(fd,fdswmaster);
+
+end;
+
+procedure tselecteventcore.wmasterclr(fd: integer);
+begin
+  if not fd_isset(fd,fdswmaster) then exit;
+  fd_clr(fd,fdswmaster);
+end;
+
+procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
+begin
+  fdreverse[fd] := reverseto;
+end;
+
+
+
+begin
+  eventcore := tselecteventcore.create;
+
+  maxs := 0;
+  fd_zero(fdsrmaster);
+  fd_zero(fdswmaster);
+end.
diff --git a/lcoretest.dof b/lcoretest.dof
new file mode 100755
index 0000000..097f5c8
--- /dev/null
+++ b/lcoretest.dof
@@ -0,0 +1,75 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=0
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=0
+DebugInfo=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+SearchPath=
+Packages=vclx30;VCL30;vcldb30;vcldbx30;VclSmp30;Qrpt30;teeui30;teedb30;tee30;IBEVNT30
+Conditionals=ipv6
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=2057
+CodePage=1252
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
diff --git a/lcoretest.dpr b/lcoretest.dpr
new file mode 100755
index 0000000..f6fe72b
--- /dev/null
+++ b/lcoretest.dpr
@@ -0,0 +1,181 @@
+program lcoretest;
+
+uses
+  lcore,
+  lsocket,
+  {$ifdef win32}
+    lcorewsaasyncselect in 'lcorewsaasyncselect.pas',
+  {$else}
+    lcoreselect,
+  {$endif}
+  dnsasync,
+  binipstuff,
+  sysutils,
+  dnssync;
+{$ifdef win32}
+  {$R *.RES}
+{$endif}
+
+type
+  tsc=class
+    procedure sessionavailable(sender: tobject;error : word);
+    procedure dataavailable(sender: tobject;error : word);
+    procedure sessionconnected(sender: tobject;error : word);
+    procedure taskrun(wparam,lparam:longint);
+    procedure timehandler(sender:tobject);
+    procedure dnsrequestdone(sender:tobject;error : word);
+    procedure sessionclosed(sender:tobject;error : word);
+  end;
+var
+  listensocket : tlsocket;
+  serversocket : tlsocket;
+  clientsocket : tlsocket;
+  sc : tsc;
+  task : tltask;
+procedure tsc.sessionavailable(sender: tobject;error : word);
+begin
+  writeln('received connection');
+  serversocket.dup(listensocket.accept);
+end;
+
+var
+  receivebuf : string;
+  receivecount : integer;
+procedure tsc.dataavailable(sender: tobject;error : word);
+var
+  receiveddata : string;
+  receivedon : string;
+  line : string;
+begin
+  receiveddata := tlsocket(sender).receivestr;
+  if sender=clientsocket then begin
+    receivedon := 'client socket';
+  end else begin
+    receivedon := 'server socket';
+  end;
+  writeln('received data '+receiveddata+' on '+receivedon);
+
+  receivebuf := receivebuf+receiveddata;
+
+  if receivebuf = 'hello world' then begin
+    receivebuf := '';
+    writeln('received hello world creating task');
+    task := tltask.create(sc.taskrun,nil,0,0);
+  end;
+  receivecount := receivecount +1;
+  if receivecount >50 then begin
+    writeln('received over 50 bits of data, pausing to let the operator take a look');
+    readln;
+    receivecount := 0;
+  end;
+  while pos(#10,receivebuf) > 0 do begin
+    line := receivebuf;
+    setlength(line,pos(#10,receivebuf)-1);
+    receivebuf := copy(receivebuf,pos(#10,receivebuf)+1,1000000);
+    if uppercase(copy(line,1,4))='PING' then begin
+      line[2] := 'o';
+      writeln('send pong:'+line);
+      clientsocket.sendstr(line+#10);
+    end;
+  end;
+end;
+
+procedure tsc.sessionconnected(sender: tobject;error : word);
+begin
+  if error=0 then begin
+    writeln('session is connected, local address is'+clientsocket.getxaddr);
+
+    if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin
+      clientsocket.sendstr('hello world');
+    end else begin
+      clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);
+    end;
+  end else begin
+    writeln('connect failed');
+  end;
+end;
+
+var
+  das : tdnsasync;
+
+procedure tsc.taskrun(wparam,lparam:longint);
+var
+  tempbinip : tbinip;
+  dummy : integer;
+begin
+  writeln('task ran');
+  writeln('closing client socket');
+  clientsocket.close;
+
+  writeln('looking up irc.ipv6.p10link.net using dnsasync');
+  das := tdnsasync.Create(nil);
+  das.onrequestdone := sc.dnsrequestdone;
+  //das.forwardfamily := af_inet6;
+  das.forwardlookup('irc.ipv6.p10link.net');
+end;
+
+procedure tsc.dnsrequestdone(sender:tobject;error : word);
+begin
+  writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');
+  clientsocket.addr := das.dnsresult;
+  clientsocket.port := '6667';
+  clientsocket.connect;
+  writeln(clientsocket.getxaddr);
+  das.free;
+end;
+
+procedure tsc.timehandler(sender:tobject);
+begin
+  //writeln('got timer event');
+end;
+procedure tsc.sessionclosed(sender:tobject;error : word);
+begin
+  Writeln('session closed with error ',error);
+end;
+var
+  timer : tltimer;
+  ipbin : tbinip;
+  dummy : integer;
+begin
+  ipbin := forwardlookup('invalid.domain',5);
+  writeln(ipbintostr(ipbin));
+
+  ipbin := forwardlookup('p10link.net',5);
+  writeln(ipbintostr(ipbin));
+
+  ipstrtobin('80.68.89.68',ipbin);
+  writeln('80.68.89.68 reverses to '+reverselookup(ipbin,5));
+
+  ipstrtobin('2001:200::8002:203:47ff:fea5:3085',ipbin);
+  writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));
+  writeln('creating and setting up listen socket');
+  listensocket := tlsocket.create(nil);
+  listensocket.addr := '::';
+  listensocket.port := '12345';
+  listensocket.onsessionavailable := sc.sessionavailable;
+  writeln('listening');
+  listensocket.listen;
+  writeln(listensocket.getxport);
+  writeln('listen socket is number ', listensocket.fdhandlein);
+  writeln('creating and setting up server socket');
+  serversocket := tlsocket.create(nil);
+  serversocket.ondataavailable := sc.dataavailable;
+  writeln('creating and setting up client socket');
+  clientsocket := tlsocket.create(nil);
+  clientsocket.addr := '::1';{'127.0.0.1';}
+  clientsocket.port := '12345';
+  clientsocket.onsessionconnected := sc.sessionconnected;
+  clientsocket.ondataAvailable := sc.dataavailable;
+  clientsocket.onsessionclosed := sc.sessionclosed;
+  writeln('connecting');
+  clientsocket.connect;
+  writeln('client socket is number ',clientsocket.fdhandlein);
+  writeln('creating and setting up timer');
+  timer := tltimer.create(nil);
+  timer.interval := 1000;
+  timer.ontimer := sc.timehandler;
+  timer.enabled := true;
+  writeln('entering message loop');
+  messageloop;
+  writeln('exiting cleanly');
+end.
diff --git a/lcoretest.res b/lcoretest.res
new file mode 100755
index 0000000..a528693
Binary files /dev/null and b/lcoretest.res differ
diff --git a/lcorewsaasyncselect.pas b/lcorewsaasyncselect.pas
new file mode 100755
index 0000000..a978c23
--- /dev/null
+++ b/lcorewsaasyncselect.pas
@@ -0,0 +1,216 @@
+unit lcorewsaasyncselect;
+
+interface
+
+implementation
+uses wcore,lcore,bsearchtree,sysutils,windows,winsock,pgtypes,messages,classes;
+type
+  twineventcore=class(teventcore)
+  public
+    procedure processmessages; override;
+    procedure messageloop; override;
+    procedure exitmessageloop;override;
+    procedure setfdreverse(fd : integer;reverseto : tlasio); override;
+    procedure rmasterset(fd : integer;islistensocket : boolean); override;
+    procedure rmasterclr(fd: integer); override;
+    procedure wmasterset(fd : integer); override;
+    procedure wmasterclr(fd: integer); override;
+  end;
+const
+  wm_dotasks=wm_user+1;
+type
+  twintimerwrapperinterface=class(ttimerwrapperinterface)
+  public
+    function createwrappedtimer : tobject;override;
+//    procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);override;
+    procedure setenabled(wrappedtimer : tobject;newvalue : boolean);override;
+    procedure setinterval(wrappedtimer : tobject;newvalue : integer);override;
+  end;
+
+procedure twineventcore.processmessages;
+begin
+  wcore.processmessages;//pass off to wcore
+end;
+procedure twineventcore.messageloop;
+begin
+  wcore.messageloop; //pass off to wcore
+end;
+procedure twineventcore.exitmessageloop;
+begin
+  wcore.exitmessageloop;
+end;
+var
+  fdreverse : thashtable;
+  fdwatches : thashtable;
+
+procedure twineventcore.setfdreverse(fd : integer;reverseto : tlasio);
+begin
+  if findtree(@fdreverse,inttostr(fd)) <> nil then deltree(@fdreverse,inttostr(fd));
+  if reverseto <> nil then addtree(@fdreverse,inttostr(fd),reverseto);
+end;
+
+var
+  hwndlcore : hwnd;
+procedure dowsaasyncselect(fd:integer; leventadd: integer; leventremove : integer);
+var
+  leventold : integer;
+  leventnew : integer;
+  wsaaresult : integer;
+begin
+  leventold := taddrint(findtree(@fdwatches,inttostr(fd)));
+  leventnew := leventold or leventadd;
+  leventnew := leventnew and not leventremove;
+  if leventold <> leventnew then begin
+    if leventold <> 0 then deltree(@fdwatches,inttostr(fd));
+    if leventnew <> 0 then addtree(@fdwatches,inttostr(fd),pointer(leventnew));
+  end;
+  wsaaresult := wsaasyncselect(fd,hwndlcore,wm_user,leventnew);
+
+end;
+
+
+//to allow detection of errors:
+//if we are asked to monitor for read or accept we also monitor for close
+//if we are asked to monitor for write we also monitor for connect
+
+
+procedure twineventcore.rmasterset(fd : integer;islistensocket : boolean);
+begin
+  if islistensocket then begin
+    //writeln('setting accept watch for socket number ',fd);
+    dowsaasyncselect(fd,FD_ACCEPT or FD_CLOSE,0);
+  end else begin
+    //writeln('setting read watch for socket number',fd);
+    dowsaasyncselect(fd,FD_READ or FD_CLOSE,0);
+  end;
+end;
+procedure twineventcore.rmasterclr(fd: integer);
+begin
+  //writeln('clearing read of accept watch for socket number ',fd);
+  dowsaasyncselect(fd,0,FD_ACCEPT or FD_READ or FD_CLOSE);
+end;
+procedure twineventcore.wmasterset(fd : integer);
+begin
+  dowsaasyncselect(fd,FD_WRITE or FD_CONNECT,0);
+end;
+
+procedure twineventcore.wmasterclr(fd: integer);
+begin
+  dowsaasyncselect(fd,0,FD_WRITE or FD_CONNECT);
+end;
+
+var
+  tasksoutstanding : boolean;
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+  socket : integer;
+  event : integer;
+  error : integer;
+  readtrigger : boolean;
+  writetrigger : boolean;
+  lasio : tlasio;
+begin
+  //writeln('got a message');
+  Result := 0;  // This means we handled the message
+  if (ahwnd=hwndlcore) and (aumsg=wm_user) then begin
+    //writeln('it appears to be a response to our wsaasyncselect');
+    socket := awparam;
+    event := alparam and $FFFF;
+    error := alparam shr 16;
+    //writeln('socket=',socket,' event=',event,' error=',error);
+    readtrigger := false;
+    writetrigger := false;
+    lasio := findtree(@fdreverse,inttostr(socket));
+    if assigned(lasio) then begin
+      if (error <> 0) or ((event and FD_CLOSE) <> 0) then begin
+        if lasio.state = wsconnecting then begin
+          lasio.onsessionconnected(lasio,error);
+        end;
+        lasio.internalclose(error);
+      end else begin
+        if (event and (FD_READ or FD_ACCEPT)) <> 0 then readtrigger := true;
+        if (event and (FD_WRITE)) <> 0 then writetrigger := true;
+
+        if readtrigger or writetrigger then lasio.handlefdtrigger(readtrigger,writetrigger);
+      end;
+      dowsaasyncselect(socket,0,0); //reset watches
+    end;
+  end else if (ahwnd=hwndlcore) and (aumsg=wm_dotasks) then begin
+      //writeln('processing tasks');
+      tasksoutstanding := false;
+      processtasks;
+  end else begin
+      //writeln('passing unknown message to defwindowproc');
+      //not passing unknown messages on to defwindowproc will cause window
+      //creation to fail! --plugwash
+      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+
+end;
+
+procedure winaddtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  if not tasksoutstanding then PostMessage(hwndlcore,wm_dotasks,0,0);
+end;
+type
+  twcoretimer = wcore.tltimer;
+
+function twintimerwrapperinterface.createwrappedtimer : tobject;
+begin
+  result := twcoretimer.create(nil);
+end;
+procedure twintimerwrapperinterface.setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);
+begin
+  twcoretimer(wrappedtimer).ontimer := newvalue;
+end;
+procedure twintimerwrapperinterface.setenabled(wrappedtimer : tobject;newvalue : boolean);
+begin
+  twcoretimer(wrappedtimer).enabled := newvalue;
+end;
+
+
+procedure twintimerwrapperinterface.setinterval(wrappedtimer : tobject;newvalue : integer);
+begin
+  twcoretimer(wrappedtimer).interval := newvalue;
+end;
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'lcoreClass');
+  GInitData: TWSAData;
+
+begin
+  eventcore := twineventcore.create;
+    if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create lcore handle, hinstance=',hinstance);
+  hwndlcore := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+  //writeln('lcore hwnd is ',hwndlcore);
+  //writeln('last error is ',GetLastError);
+  onaddtask := winaddtask;
+  timerwrapperinterface := twintimerwrapperinterface.create(nil);
+
+  WSAStartup($200, GInitData);
+end.
diff --git a/lloopback.pas b/lloopback.pas
new file mode 100755
index 0000000..7e26d7c
--- /dev/null
+++ b/lloopback.pas
@@ -0,0 +1,34 @@
+unit lloopback;
+
+interface
+uses lcore,classes;
+
+type
+  tlloopback=class(tlasio)
+  public
+    constructor create(aowner:tcomponent); override;
+  end;
+
+
+implementation
+uses
+{$ifdef ver1_0}
+  linux;
+{$else}
+  baseunix,unix,unixutil;  
+{$endif}
+{$i unixstuff.inc}
+
+constructor tlloopback.create(aowner:tcomponent);
+begin
+  inherited create(aowner);
+  closehandles := true;
+  assignpipe(fdhandlein,fdhandleout);
+
+  eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
+  eventcore.wmasterclr(fdhandlein);//fd_clr(fdhandleout,fdswmaster);
+  eventcore.setfdreverse(fdhandlein,self);
+  eventcore.setfdreverse(fdhandleout,self);
+  state := wsconnected;
+end;
+end.
diff --git a/lmessages.pas b/lmessages.pas
new file mode 100755
index 0000000..7bb73fd
--- /dev/null
+++ b/lmessages.pas
@@ -0,0 +1,656 @@
+unit lmessages;
+//windows messages like system based on lcore tasks
+interface
+
+uses pgtypes,sysutils,bsearchtree,strings,syncobjs;
+
+type
+  lparam=taddrint;
+  wparam=taddrint;
+  thinstance=pointer;
+  hicon=pointer;
+  hcursor=pointer;
+  hbrush=pointer;
+  hwnd=qword; //window handles are monotonically increasing 64 bit integers,
+              //this should allow for a million windows per second for over half
+              //a million years!
+
+  twndproc=function(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+
+
+  twndclass=record
+    style : dword;
+    lpfnwndproc : twndproc;
+    cbclsextra : integer;
+    cbwndextra : integer;
+    hinstance : thinstance;
+    hicon : hicon;
+    hcursor : hcursor;
+    hbrbackground : hbrush;
+    lpszmenuname : pchar;
+    lpszclassname : pchar;
+  end;
+  PWNDCLASS=^twndclass;
+  
+  UINT=dword;
+  WINBOOL = longbool;
+  tTIMERPROC = procedure (ahwnd:HWND; umsg:integer; idevent:taddrint;dwtime:taddrint);stdcall;
+  ATOM = pointer;
+  LPCSTR = pchar;
+  LPVOID = pointer;
+  HMENU = pointer;
+  HINST = pointer;
+
+  TPOINT = record 
+    x : LONGint; 
+    y : LONGint; 
+  end; 
+  
+  TMSG = record 
+    hwnd : HWND; 
+    message : UINT; 
+    wParam : WPARAM; 
+    lParam : LPARAM; 
+    time : DWORD; 
+    pt : TPOINT;
+  end; 
+  THevent=TEventObject;
+const
+  WS_EX_TOOLWINDOW = $80;
+  WS_POPUP = longint($80000000);
+  hinstance=nil;
+  PM_REMOVE = 1;
+  WM_USER = 1024;
+  WM_TIMER = 275;
+  INFINITE = syncobjs.infinite;
+function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
+function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
+function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
+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;
+function DestroyWindow(ahWnd:HWND):WINBOOL;
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
+function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
+function DispatchMessage(const lpMsg: TMsg): Longint;
+function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
+function SetEvent(hEvent:THevent):WINBOOL;
+function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
+function terminatethread(threadhandle : tthreadid;dummy:integer) : boolean;
+function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
+function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
+function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
+
+procedure init;
+
+implementation
+uses
+  baseunix,unix,lcore;//,safewriteln;
+{$i unixstuff.inc}
+
+type
+  tmessageintransit = class
+    msg : tmsg;
+    next : tmessageintransit;
+  end;
+
+  tthreaddata = class
+    messagequeue : tmessageintransit;
+    messageevent : teventobject;
+    waiting : boolean;
+    lcorethread : boolean;
+    nexttimer : ttimeval;
+    threadid : integer;
+  end;
+  twindow=class
+    hwnd : hwnd;
+    extrawindowmemory : pointer;
+    threadid : tthreadid;
+    windowproc : twndproc;
+  end;
+
+var
+  structurelock : tcriticalsection;
+  threaddata : thashtable;
+  windowclasses : thashtable;
+  lcorelinkpipesend : integer;
+  lcorelinkpiperecv : tlasio;
+  windows : thashtable;
+  //I would rather things crash immediately
+  //if they use an insufficiant size type
+  //than crash after over four billion
+  //windows have been made ;)
+  nextwindowhandle : qword = $100000000;
+{$i ltimevalstuff.inc}
+
+//findthreaddata should only be called while holding the structurelock
+function findthreaddata(threadid : integer) : tthreaddata;
+begin
+  result := tthreaddata(findtree(@threaddata,inttostr(threadid)));
+  if result = nil then begin
+    result := tthreaddata.create;
+    result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result)));
+    result.nexttimer := tv_invalidtimebig;
+    result.threadid := threadid;
+    addtree(@threaddata,inttostr(threadid),result);
+  end;
+end;
+
+//deletethreaddataifunused should only be called while holding the structurelock
+procedure deletethreaddataifunused(athreaddata : tthreaddata);
+begin
+  //writeln('in deletethreaddataifunused');
+  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
+    //writeln('threaddata is unused, freeing messageevent');
+    athreaddata.messageevent.free;
+    //writeln('freeing thread data object');
+    athreaddata.free;
+    //writeln('deleting thread data object from hashtable');
+    deltree(@threaddata,inttostr(athreaddata.threadid));
+    //writeln('finished deleting thread data');
+  end else begin
+    //writeln('thread data is not unused');
+  end;
+end;
+
+function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint;
+var
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window <> nil then begin
+      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
+    end else begin
+      result := 0;
+    end;
+  finally
+    structurelock.release;
+  end;
+end;
+
+function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint;
+var
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window <> nil then begin
+      result := paddrint(taddrint(window.extrawindowmemory)+nindex)^;
+      paddrint(taddrint(window.extrawindowmemory)+nindex)^ := dwnewlong;
+    end else begin
+      result := 0;
+    end;
+  finally
+    structurelock.release;
+  end;
+
+end;
+
+
+function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall;
+begin
+  result := 0;
+end;
+
+function strdup(s:pchar) : pchar;
+begin
+  //swriteln('in strdup, about to allocate memory');
+  result := getmem(strlen(s)+1);
+  //swriteln('about to copy string');
+  strcopy(s,result);
+  //swriteln('leaving strdup');
+end;
+
+function RegisterClass(const lpWndClass:TWNDCLASS):ATOM;
+var
+  storedwindowclass:pwndclass;
+begin
+  structurelock.acquire;
+  try
+    //swriteln('in registerclass, about to check for duplicate window class');
+    storedwindowclass := findtree(@windowclasses, lpwndclass.lpszclassname);
+    if storedwindowclass <> nil then begin
+
+      if comparebyte(storedwindowclass^,lpwndclass,sizeof(twndclass)-sizeof(pchar)-sizeof(pchar)) <> 0 then begin
+        //swriteln('duplicate window class registered with different settings');
+        raise exception.create('duplicate window class registered with different settings');
+      end else begin
+        //swriteln('duplicate window class registered with same settings, tollerated');
+      end;
+    end else begin
+      //swriteln('about to allocate memory for new windowclass');
+      storedwindowclass := getmem(sizeof(twndclass));
+      //swriteln('about to copy windowclass from parameter');
+      move(lpwndclass,storedwindowclass^,sizeof(twndclass));
+      //swriteln('about to copy strings');
+      if lpwndclass.lpszmenuname <> nil then storedwindowclass.lpszmenuname := strdup(lpwndclass.lpszmenuname);
+      if lpwndclass.lpszclassname <> nil then storedwindowclass.lpszclassname := strdup(lpwndclass.lpszclassname);
+      //swriteln('about to add result to list of windowclasses');
+      addtree(@windowclasses,lpwndclass.lpszclassname,storedwindowclass);
+    end;
+    //swriteln('about to return result');
+    result := storedwindowclass;
+    //swriteln('leaving registerclass');
+  finally
+    structurelock.release;
+  end;
+end;
+
+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;
+var
+  wndclass : pwndclass;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := twindow.create;
+    window.hwnd := nextwindowhandle;
+    result := window.hwnd;
+    nextwindowhandle := nextwindowhandle + 1;
+    addtree(@windows,inttostr(window.hwnd),window);
+    wndclass := findtree(@windowclasses,lpclassname);
+    window.extrawindowmemory := getmem(wndclass.cbwndextra);
+
+    getthreadmanager(tm);
+    window.threadid := tm.GetCurrentThreadId;
+    window.windowproc := wndclass.lpfnwndproc;
+  finally
+    structurelock.release;
+  end;
+end;
+function DestroyWindow(ahWnd:HWND):WINBOOL;
+var
+  window : twindow;
+  windowthreaddata : tthreaddata;
+  currentmessage : tmessageintransit;
+  prevmessage : tmessageintransit;
+begin
+  //writeln('started to destroy window');
+  structurelock.acquire;
+  try
+    window := twindow(findtree(@windows,inttostr(ahwnd)));
+    if window <> nil then begin
+      freemem(window.extrawindowmemory);
+      //writeln('aboute to delete window from windows structure');
+      deltree(@windows,inttostr(ahwnd));
+      //writeln('deleted window from windows structure');
+      windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid)));
+
+      if windowthreaddata <> nil then begin
+        //writeln('found thread data scanning for messages to clean up');
+        currentmessage := windowthreaddata.messagequeue;
+        prevmessage := nil;
+        while currentmessage <> nil do begin
+          while (currentmessage <> nil) and (currentmessage.msg.hwnd = ahwnd) do begin
+            if prevmessage = nil then begin
+              windowthreaddata.messagequeue := currentmessage.next;
+            end else begin
+              prevmessage.next := currentmessage.next;
+            end;
+            currentmessage.free;
+            if prevmessage = nil then begin
+              currentmessage := windowthreaddata.messagequeue;
+            end else begin
+              currentmessage := prevmessage.next;
+            end;
+          end;
+          if currentmessage <> nil then begin
+            prevmessage := currentmessage;
+            currentmessage := currentmessage.next;
+          end;
+        end;
+        //writeln('deleting thread data structure if it is unused');
+        deletethreaddataifunused(windowthreaddata);
+      end else begin
+        //writeln('there is no thread data to search for messages to cleanup');
+      end;
+      //writeln('freeing window');
+      window.free;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  finally
+    structurelock.release;
+  end;
+  //writeln('window destroyed');
+end;
+
+
+
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL;
+var
+  threaddata : tthreaddata;
+  message : tmessageintransit;
+  messagequeueend : tmessageintransit;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(hwnd));
+    if window <> nil then begin
+      threaddata := findthreaddata(window.threadid);
+      message := tmessageintransit.create;
+      message.msg.hwnd := hwnd;
+      message.msg.message := msg;
+      message.msg.wparam := wparam;
+      message.msg.lparam := lparam;
+      if threaddata.lcorethread then begin
+        //swriteln('posting message to lcore thread');
+        fdwrite(lcorelinkpipesend,message,sizeof(message));
+      end else begin
+        //writeln('posting message to non lcore thread');
+        if threaddata.messagequeue = nil then begin
+          threaddata.messagequeue := message;
+        end else begin
+          messagequeueend := threaddata.messagequeue;
+          while messagequeueend.next <> nil do begin
+            messagequeueend := messagequeueend.next;
+          end;
+          messagequeueend.next := message;
+        end;
+
+        //writeln('message added to queue');
+        if threaddata.waiting then threaddata.messageevent.setevent;
+      end;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  finally
+    structurelock.release;
+  end;
+
+end;
+
+function gettickcount : dword;
+var
+  result64: integer;
+  tv : ttimeval;
+begin
+  gettimeofday(tv);
+  result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);
+  result := result64;
+end;
+
+function DispatchMessage(const lpMsg: TMsg): Longint;
+var
+  timerproc : ttimerproc;
+  window : twindow;
+  windowproc : twndproc;
+begin
+  ////swriteln('in dispatchmessage, msg.hwnd='+inttohex(taddrint(lpmsg.hwnd),16));
+  if (lpmsg.lparam <> 0) and (lpmsg.message = WM_TIMER) then begin
+    timerproc := ttimerproc(lpmsg.lparam);
+    timerproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,gettickcount);
+    result := 0;
+  end else begin
+    structurelock.acquire;
+    try
+      window := findtree(@windows,inttostr(lpmsg.hwnd));
+      //we have to get the window procedure while the structurelock
+      //is still held as the window could be destroyed from another thread
+      //otherwise.
+      windowproc := window.windowproc;
+    finally
+      structurelock.release;
+    end;
+    if window <> nil then begin
+      result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam);
+    end else begin
+      result := -1;
+    end;
+  end;
+end;
+
+procedure processtimers;
+begin
+end;
+
+function GetMessageinternal(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT; wremovemsg : UINT;peek:boolean): WINBOOL;
+var
+  tm : tthreadmanager;
+  threaddata : tthreaddata;
+  message : tmessageintransit;
+  nowtv : ttimeval;
+  timeouttv : ttimeval;
+  timeoutms : int64;
+
+begin
+  if hwnd <> 0 then raise exception.create('getting messages for an individual window is not supported');
+  if (wmsgfiltermin <> 0) or (wmsgfiltermax <> 0) then raise exception.create('message filtering is not supported');
+  structurelock.acquire;
+  result := true;
+  try
+    getthreadmanager(tm);
+    threaddata := findthreaddata(tm.GetCurrentThreadId);
+    if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');
+    message := threaddata.messagequeue;
+    gettimeofday(nowtv);
+    while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin
+      threaddata.waiting := true;
+      structurelock.release;
+      if (threaddata.nexttimer.tv_sec = TV_invalidtimebig.tv_sec) and (threaddata.nexttimer.tv_usec = TV_invalidtimebig.tv_usec) then begin
+        threaddata.messageevent.waitfor(INFINITE);
+      end else begin
+
+        timeouttv := threaddata.nexttimer;
+        timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);
+        //i'm assuming the timeout is in milliseconds
+        if (timeoutms > maxlongint) then timeoutms := maxlongint;
+        threaddata.messageevent.waitfor(timeoutms);
+
+      end;
+      structurelock.acquire;
+      threaddata.waiting := false;
+      message := threaddata.messagequeue;
+      gettimeofday(nowtv);
+    end;
+    if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin
+      processtimers;
+    end;
+    message := threaddata.messagequeue;
+    if message <> nil then begin
+      lpmsg := message.msg;
+      if wremovemsg=PM_REMOVE then begin
+        threaddata.messagequeue := message.next;
+        message.free;
+      end;
+    end else begin
+      result :=false;
+    end;
+    deletethreaddataifunused(threaddata);
+  finally
+    structurelock.release;
+  end;
+end;
+
+function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): WINBOOL;
+begin
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,false);
+end;
+
+function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL;
+begin
+  result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true);
+end;
+
+function SetEvent(hEvent:THevent):WINBOOL;
+begin
+  hevent.setevent;
+  result := true;
+end;
+
+function CreateEvent(lpEventAttributes:PSECURITYATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:pchar):tHevent;
+begin
+  result := teventobject.create(lpeventattributes,bmanualreset,binitialstate,lpname);
+end;
+
+function terminatethread(threadhandle:tthreadid;dummy : integer) : boolean;
+var
+  tm : tthreadmanager;
+begin
+  getthreadmanager(tm);
+  tm.killthread(threadhandle);
+  result := true;
+end;
+
+function waitforsingleevent(event:thevent;timeout:cardinal) : twaitresult;
+begin
+  result := event.waitfor(timeout);
+end;
+
+procedure removefrombuffer(n : integer; var buffer:string);
+begin
+  if n=length(buffer) then begin
+    buffer := '';
+  end else begin
+    uniquestring(buffer);
+    move(buffer[n+1],buffer[1],length(buffer)-n);
+    setlength(buffer,length(buffer)-n);
+  end;
+end;
+
+type
+  tsc=class
+    procedure available(sender:tobject;error:word);
+  end;
+
+var
+  recvbuf : string;
+
+procedure tsc.available(sender:tobject;error:word);
+var
+  message : tmessageintransit;
+  messagebytes : array[1..sizeof(tmessageintransit)] of char absolute  message;
+  i : integer;
+begin
+  //swriteln('received data on lcorelinkpipe');
+  recvbuf := recvbuf + lcorelinkpiperecv.receivestr;
+  while length(recvbuf) >= sizeof(tmessageintransit) do begin
+    for i := 1 to sizeof(tmessageintransit) do begin
+      messagebytes[i] := recvbuf[i];
+    end;
+    dispatchmessage(message.msg);
+    message.free;
+    removefrombuffer(sizeof(tmessageintransit),recvbuf);
+  end;
+end;
+
+procedure init;
+var
+  tm : tthreadmanager;
+  threaddata : tthreaddata;
+  pipeends : tfildes;
+  sc : tsc;
+begin
+  structurelock := tcriticalsection.create;
+  getthreadmanager(tm);
+  threaddata := findthreaddata(tm.GetCurrentThreadId);
+  threaddata.lcorethread := true;
+  fppipe(pipeends);
+  lcorelinkpipesend := pipeends[1];
+  lcorelinkpiperecv := tlasio.create(nil);
+  lcorelinkpiperecv.dup(pipeends[0]);
+  lcorelinkpiperecv.ondataavailable := sc.available;
+  recvbuf := '';
+end;
+
+var
+  lcorethreadtimers : thashtable;
+type
+  tltimerformsg = class(tltimer)
+  public
+    hwnd : hwnd;
+    id : taddrint;
+    procedure timer(sender : tobject);
+  end;
+
+procedure tltimerformsg.timer(sender : tobject);
+var
+  msg : tmsg;
+begin
+  ////swriteln('in tltimerformsg.timer');
+  fillchar(msg,sizeof(msg),0);
+  msg.message := WM_TIMER;
+  msg.hwnd := hwnd;
+  msg.wparam := ID;
+  msg.lparam := 0;
+  dispatchmessage(msg);
+end;
+
+function SetTimer(ahWnd:HWND; nIDEvent:taddrint; uElapse:UINT; lpTimerFunc:tTIMERPROC):UINT;
+var
+  threaddata : tthreaddata;
+  ltimer : tltimerformsg;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window= nil then raise exception.create('invalid window');
+    threaddata := findthreaddata(window.threadid);
+  finally
+    structurelock.release;
+  end;
+  if threaddata.lcorethread then begin
+    getthreadmanager(tm);
+    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and removed from the lcore thread');
+    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
+    if @lptimerfunc <> nil then raise exception.create('seperate timer functions are not supported');
+
+    //remove preexisting timer with same ID
+    killtimer(ahwnd,nIDEvent);
+
+    ltimer := tltimerformsg.create(nil);
+    ltimer.interval := uelapse;
+    ltimer.id := nidevent;
+    ltimer.hwnd := ahwnd;
+    ltimer.enabled := true;
+    ltimer.ontimer := ltimer.timer;
+
+    addtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(nIDEvent),ltimer);
+
+    result := nidevent;
+  end else begin
+    raise exception.create('settimer not implemented for threads other than the lcore thread');
+  end;
+end;
+
+function KillTimer(ahWnd:HWND; uIDEvent:taddrint):WINBOOL;
+var
+  threaddata : tthreaddata;
+  ltimer : tltimerformsg;
+  tm : tthreadmanager;
+  window : twindow;
+begin
+  structurelock.acquire;
+  try
+    window := findtree(@windows,inttostr(ahwnd));
+    if window= nil then raise exception.create('invalid window');
+    threaddata := findthreaddata(window.threadid);
+  finally
+    structurelock.release;
+  end;
+  if threaddata.lcorethread then begin
+    getthreadmanager(tm);
+    if tm.GetCurrentThreadId <> window.threadid then raise exception.create('timers on the lcore thread may only be added and remove from the lcore thread');
+    if ahwnd = 0 then raise exception.create('timers on the lcore thread must be associated with a window handle');
+    ltimer := tltimerformsg(findtree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent)));
+    if ltimer <> nil then begin
+      deltree(@lcorethreadtimers,inttostr(taddrint(ahwnd))+' '+inttostr(uIDEvent));
+      ltimer.free;
+      result := true;
+    end else begin
+      result := false;
+    end;
+  end else begin
+    raise exception.create('settimer not implemented for threads other than the lcore thread');
+  end;
+end;
+
+end.
\ No newline at end of file
diff --git a/lsignal.pas b/lsignal.pas
new file mode 100755
index 0000000..49e51b2
--- /dev/null
+++ b/lsignal.pas
@@ -0,0 +1,201 @@
+{lsocket.pas}
+
+{signal code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+      
+unit lsignal;
+{$mode delphi}
+interface
+  uses sysutils,
+    {$ifdef VER1_0}
+      linux,
+    {$else}
+      baseunix,unix,unixutil,
+    {$endif}
+    classes,lcore,lloopback;
+
+  type
+    tsignalevent=procedure(sender:tobject;signal:integer) of object;
+    tlsignal=class(tcomponent)
+    public
+      onsignal           : tsignalevent      ;
+      prevsignal         : tlsignal          ;
+      nextsignal         : tlsignal          ;
+
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+    end;
+
+  
+  procedure starthandlesignal(signal:integer);
+
+var
+  firstsignal : tlsignal;
+  blockset : sigset;
+  signalloopback                        : tlloopback ;
+  
+implementation
+{$include unixstuff.inc}
+
+constructor tlsignal.create;
+begin
+  inherited create(AOwner);
+  nextsignal := firstsignal;
+  prevsignal := nil;
+
+  if assigned(nextsignal) then nextsignal.prevsignal := self;
+  firstsignal := self;
+
+  //interval := 1000;
+  //enabled := true;
+  //released := false;
+end;
+
+destructor tlsignal.destroy;
+begin
+  if prevsignal <> nil then begin
+    prevsignal.nextsignal := nextsignal;
+  end else begin
+    firstsignal := nextsignal;
+  end;
+  if nextsignal <> nil then begin
+    nextsignal.prevsignal := prevsignal;
+  end;
+  inherited destroy;
+end;
+{$ifdef linux}
+  {$ifdef ver1_9_8}
+    {$define needsignalworkaround}
+  {$endif}
+  {$ifdef ver2_0_0}
+    {$define needsignalworkaround}
+  {$endif}
+  {$ifdef ver2_0_2}
+    {$define needsignalworkaround}
+  {$endif}
+{$endif}
+{$ifdef needsignalworkaround}
+  //using the 1.9.6 version of this stuff because the 1.9.8 and 2.0.0 versions seem broken
+  type
+    TSysParam  = Longint;
+    TSysResult = longint;
+  const
+            syscall_nr_sigaction		= 67;
+  //function Do_SysCall(sysnr:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
+  //function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
+  //function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
+  function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
+  //function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
+  //function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
+
+  function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint;// [public, alias : 'FPC_SYSC_SIGACTION'];
+  {
+    Change action of process upon receipt of a signal.
+    Signum specifies the signal (all except SigKill and SigStop).
+    If Act is non-nil, it is used to specify the new action.
+    If OldAct is non-nil the previous action is saved there.
+  }
+  begin
+  //writeln('fucking');
+  {$ifdef RTSIGACTION}
+    {$ifdef cpusparc}
+      { Sparc has an extra stub parameter }
+      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));
+    {$else cpusparc}
+      Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));
+    {$endif cpusparc}
+  {$else RTSIGACTION}
+    //writeln('nice');
+    Fpsigaction:=do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
+  {$endif RTSIGACTION}
+  end;
+{$endif}
+
+// cdecl procedures are not name mangled
+// so USING something unlikely to cause colliesions in the global namespace
+// is a good idea
+procedure lsignal_handler( Sig : Integer);cdecl;
+var
+  currentsignal : tlsignal;
+begin
+//  writeln('in lsignal_hanler');
+  currentsignal := firstsignal;
+  while assigned(currentsignal) do begin
+    if assigned(currentsignal.onsignal) then currentsignal.onsignal(currentsignal,sig);
+    currentsignal := currentsignal.nextsignal;
+
+  end;
+//  writeln('about to send down signalloopback');
+  if assigned(signalloopback) then begin
+    signalloopback.sendstr(' ');
+  end;
+//  writeln('left lsignal_hanler');
+end;
+
+{$ifdef freebsd}
+
+{$if (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))}
+procedure lsignal_handler2(signal:longint;info:PSigInfo;context:psigcontext); cdecl;
+{$else}
+procedure lsignal_handler2(signal:longint;var info:TSigInfo_t;var context:SigContextRec); cdecl;
+{$endif}
+
+begin
+  lsignal_handler(signal);
+end;
+{$endif}
+
+
+const
+  allbitsset=-1;
+  {$ifdef ver1_0}
+    saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
+  {$else}
+    {$ifdef darwin}
+      saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
+    {$else}
+      {$ifdef freebsd}
+        //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
+        {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
+          saction : sigactionrec = (sa_handler:lsignal_handler2;sa_flags:0);
+        {$else}
+          saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
+        {$endif}
+							  
+      {$else}
+        {$ifdef ver1_9_2}
+          saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
+        {$else}
+	  //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
+	  {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
+	    saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler);sa_flags:0;sa_restorer:nil);
+	  {$else}
+            saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler));
+	  {$endif}
+        {$endif}
+      {$endif}
+    {$endif}
+  {$endif}
+procedure starthandlesignal(signal:integer);
+begin
+  if signal in ([0..31]-[sigkill,sigstop]) then begin
+    sigprocmask(SIG_BLOCK,@blockset,nil);
+    sigaction(signal,@saction,nil)
+  end else begin
+    raise exception.create('invalid signal number')
+  end;
+end;
+
+initialization
+  fillchar(blockset,sizeof(blockset),0);
+  blockset[0] := $FFFFFFFF - (1 shl sigstop) - (1 shl sigkill) - (1 shl sigsegv);
+  {$ifdef ver1_0}
+    saction.sa_mask := blockset[0];
+  {$else}
+    saction.sa_mask := blockset;
+  {$endif}
+end.
diff --git a/lsocket.pas b/lsocket.pas
new file mode 100755
index 0000000..58f157d
--- /dev/null
+++ b/lsocket.pas
@@ -0,0 +1,706 @@
+{lsocket.pas}
+
+{socket code by plugwash}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+{
+changes by plugwash (20030728)
+* created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it
+* changed tlasio to tlasio
+* split fdhandle into fdhandlein and fdhandleout
+* i now use fdsrmaster and fdswmaster instead of rebuilding the lists every loop
+* split lsocket.pas into lsocket.pas and lcore.pas
+
+
+changes by beware (20030903)
+* added getxaddr, getxport (local addr, port, as string)
+* added getpeername, remote addr+port as binary
+* added htons and htonl functions (endian swap, same interface as windows API)
+
+beware (20030905)
+* if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose)
+* (lcore) if closing the fd's in internalcose, set fd's to -1 because closing an fd makes it invalid
+
+beware (20030927)
+* fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check
+
+beware (20031017)
+* added getpeeraddr, getpeerport, remote addr+port as string
+}
+
+
+unit lsocket;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+interface
+  uses
+    sysutils,
+    {$ifdef win32}
+      windows,winsock,
+    {$else}
+
+      {$ifdef VER1_0}
+        linux,
+      {$else}
+        baseunix,unix,unixutil,
+      {$endif}
+      sockets,
+    {$endif}
+    classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync;
+type
+  sunB = packed record
+    s_b1, s_b2, s_b3, s_b4: byte;
+  end;
+
+  SunW = packed record
+    s_w1, s_w2: word;
+  end;
+
+  TInAddr = packed record
+    case integer of
+      0: (S_un_b: SunB);
+      1: (S_un_w: SunW);
+      2: (S_addr: cardinal);
+  end;
+  {$ifdef ipv6}
+    {$ifdef ver1_0}
+      cuint16=word;
+      cuint32=dword;
+      sa_family_t=word;
+
+
+      TInetSockAddr6 = packed Record
+        sin6_family   : sa_family_t;
+        sin6_port     : cuint16;
+        sin6_flowinfo : cuint32;
+        sin6_addr     : Tin6_addr;
+        sin6_scope_id : cuint32;
+      end;
+    {$endif}
+  {$endif}
+  TinetSockAddrv = packed record
+    case integer of
+      0: (InAddr:TInetSockAddr);
+      {$ifdef ipv6}
+      1: (InAddr6:TInetSockAddr6);
+      {$endif}
+  end;
+  Pinetsockaddrv = ^Tinetsockaddrv;
+
+
+  type
+    tsockaddrin=TInetSockAddr;
+
+  type
+    TLsocket = class(tlasio)
+    public
+      //a: string;
+
+      inAddr             : TInetSockAddrV;
+{      inAddrSize:integer;}
+
+      //host               : THostentry      ;
+
+      //mainthread         : boolean         ; //for debuggin only
+      addr:string;
+      port:string;
+      localaddr:string;
+      localport:string;
+      proto:string;
+      udp:boolean;
+      listenqueue:integer;
+      function getaddrsize:integer;
+      procedure connect; virtual;
+      procedure bindsocket;
+      procedure listen;
+      function accept : longint;
+      function sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer; virtual;
+      function receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer; virtual;
+      //procedure internalclose(error:word);override;
+      procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
+      function send(data:pointer;len:integer):integer;override;
+      procedure sendstr(const str : string);override;
+      function Receive(Buf:Pointer;BufSize:integer):integer; override;
+      function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;
+      procedure getXaddrbin(var binip:tbinip); virtual;
+      procedure getpeeraddrbin(var binip:tbinip); virtual;
+      function getXaddr:string; virtual;
+      function getpeeraddr:string; virtual;
+      function getXport:string; virtual;
+      function getpeerport:string; virtual;
+      constructor Create(AOwner: TComponent); override;
+      {$ifdef win32}
+        procedure myfdclose(fd : integer); override;
+        function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;
+        function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override;
+      {$endif}
+    end;
+    tsocket=longint; // for compatibility with twsocket
+
+  twsocket=tlsocket; {easy}
+
+function htons(w:word):word;
+function htonl(i:integer):integer;
+{!!!function longipdns(s:string):longint;}
+
+{$ifdef ipv6}
+const
+  v4listendefault:boolean=false;
+{$endif}
+
+
+const
+  TCP_NODELAY=1;
+  IPPROTO_TCP=6;
+
+implementation
+{$include unixstuff.inc}
+
+function longip(s:string):longint;{$ifdef fpc}inline;{$endif}
+var
+  l:longint;
+  a,b:integer;
+
+function convertbyte(const s:string):integer;{$ifdef fpc}inline;{$endif}
+begin
+  result := strtointdef(s,-1);
+  if result < 0 then exit;
+  if result > 255 then exit;
+
+  {01 exception}
+  if (result <> 0) and (s[1] = '0') then begin
+    result := -1;
+    exit;
+  end;
+
+  {+1 exception}
+  if not (s[1] in ['0'..'9']) then begin
+    result := -1;
+    exit
+  end;
+end;
+
+begin
+  result := 0;
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := b shl 24;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 16;
+  s := copy(s,a+1,256);
+  a := pos('.',s);
+  if a = 0 then exit;
+  b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;
+  l := l or b shl 8;
+  s := copy(s,a+1,256);
+  b := convertbyte(copy(s,1,256));if (b < 0) then exit;
+  l := l or b;
+  result := l;
+end;
+
+(*!!!
+function longipdns(s:string):longint;
+var
+  host : thostentry;
+begin
+  if s = '0.0.0.0' then begin
+    result := 0;
+  end else begin
+    result := longip(s);
+    if result = 0 then begin
+      if gethostbyname(s,host) then begin;
+        result := htonl(Longint(Host.Addr));
+      end;
+      //writeln(inttohex(longint(host.addr),8))
+    end;
+    if result = 0 then begin
+      if resolvehostbyname(s,host) then begin;
+        result := htonl(Longint(Host.Addr));
+      end;
+      //writeln(inttohex(longint(host.addr),8))
+    end;
+  end;
+end;
+*)
+
+
+function htons(w:word):word;
+begin
+  {$ifndef ENDIAN_BIG}
+  result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
+  {$else}
+  result := w;
+  {$endif}
+end;
+
+function htonl(i:integer):integer;
+begin
+  {$ifndef ENDIAN_BIG}
+  result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
+  {$else}
+  result := i;
+  {$endif}
+end;
+
+function tlsocket.getaddrsize:integer;
+begin
+  {$ifdef ipv6}
+  if inaddr.inaddr.family = AF_INET6 then result := sizeof(tinetsockaddr6) else
+  {$endif}
+  result := sizeof(tinetsockaddr);
+end;
+
+function makeinaddrv(addr,port:string;var inaddr:tinetsockaddrv):integer;
+var
+  biniptemp:tbinip;
+begin
+  result := 0;
+  biniptemp := forwardlookup(addr,10);
+  fillchar(inaddr,sizeof(inaddr),0);
+  //writeln('converted address '+addr+' to binip '+ipbintostr(biniptemp));
+  if biniptemp.family = AF_INET then begin
+    inAddr.InAddr.family:=AF_INET;
+    inAddr.InAddr.port:=htons(strtointdef(port,0));
+    inAddr.InAddr.addr:=biniptemp.ip;
+    result := sizeof(tinetsockaddr);
+  end else
+  {$ifdef ipv6}
+  if biniptemp.family = AF_INET6 then begin
+    inAddr.InAddr6.sin6_family:=AF_INET6;
+    inAddr.InAddr6.sin6_port:=htons(strtointdef(port,0));
+    inAddr.InAddr6.sin6_addr:=biniptemp.ip6;
+    result := sizeof(tinetsockaddr6);
+  end else
+  {$endif}
+  raise esocketexception.create('unable to resolve address: '+addr);
+end;
+
+procedure tlsocket.connect;
+var
+  a:integer;
+begin
+  if state <> wsclosed then close;
+  //prevtime := 0;
+  makeinaddrv(addr,port,inaddr);
+
+  udp := uppercase(proto) = 'UDP';
+  if udp then a := SOCK_DGRAM else a := SOCK_STREAM;
+  a := Socket(inaddr.inaddr.family,a,0);
+
+  //writeln(ord(inaddr.inaddr.family));
+  if a = -1 then begin
+    lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
+    raise esocketexception.create('unable to create socket');
+  end;
+  try
+    dup(a);
+    bindsocket;
+    if udp then begin
+      {$ifndef win32}
+        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
+      {$endif}
+      state := wsconnected;
+      if assigned(onsessionconnected) then onsessionconnected(self,0);
+    end else begin
+      state :=wsconnecting;
+      {$ifdef win32}
+        //writeln(inaddr.inaddr.port);
+        winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
+      {$else}
+        sockets.Connect(fdhandlein,inADDR,getaddrsize);
+      {$endif}
+    end;
+    eventcore.rmasterset(fdhandlein,false);
+    if udp then begin
+      eventcore.wmasterclr(fdhandleout);
+    end else begin
+      eventcore.wmasterset(fdhandleout);
+    end;
+    //sendq := '';
+  except
+    on e: exception do begin
+      fdcleanup;
+      raise; //reraise the exception
+    end;
+  end;
+end;
+
+procedure tlsocket.sendstr(const str : string);
+begin
+  if udp then begin
+    send(@str[1],length(str))
+  end else begin
+    inherited sendstr(str);
+  end;
+end;
+
+function tlsocket.send(data:pointer;len:integer):integer;
+begin
+  if udp then begin
+    //writeln('sending to '+inttohex(inaddr.inaddr.addr,8));
+    result := sendto(inaddr.inaddr,getaddrsize,data,len)
+;
+    //writeln('send result',result);
+    //writeln('errno',errno);
+  end else begin
+    result := inherited send(data,len);
+  end;
+end;
+
+
+function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
+begin
+  if udp then begin
+    result := myfdread(self.fdhandlein,buf^,bufsize);
+  end else begin
+    result := inherited receive(buf,bufsize);
+  end;
+end;
+
+procedure tlsocket.bindsocket;
+var
+  a:integer;
+  inAddrtemp:TInetSockAddrV;
+  inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
+  inaddrtempsize:integer;
+begin
+  try
+    if (localaddr <> '') or (localport <> '') then begin
+      if localaddr = '' then begin
+        {$ifdef ipv6}
+        if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
+        {$endif}
+        localaddr := '0.0.0.0';
+      end;
+      //gethostbyname(localaddr,host);
+
+      inaddrtempsize := makeinaddrv(localaddr,localport,inaddrtemp);
+
+      If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin
+        state := wsclosed;
+        lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
+        raise ESocketException.create('unable to bind, error '+inttostr(lasterror));
+      end;
+      state := wsbound;
+    end;
+  except
+    on e: exception do begin
+      fdcleanup;
+      raise; //reraise the exception
+    end;
+  end;
+end;
+
+procedure tlsocket.listen;
+var
+  yes:longint;
+  socktype:integer;
+  biniptemp:tbinip;
+  origaddr:string;
+begin
+  if state <> wsclosed then close;
+  udp := uppercase(proto) = 'UDP';
+  if udp then socktype := SOCK_DGRAM else socktype := SOCK_STREAM;
+  origaddr := addr;
+
+  if addr = '' then begin
+    {$ifdef ipv6}
+    if not v4listendefault then begin
+      addr := '::';
+    end else
+    {$endif}
+    addr := '0.0.0.0';
+  end;
+  biniptemp := forwardlookup(addr,10);
+  addr := ipbintostr(biniptemp);
+  fdhandlein := socket(biniptemp.family,socktype,0);
+  {$ifdef ipv6}
+  if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
+    addr := '0.0.0.0';
+    fdhandlein := socket(AF_INET,socktype,0);
+  end;
+  {$endif}
+  if fdhandlein = -1 then raise ESocketException.create('unable to create socket');
+  dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
+  //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
+  state := wsclosed; // then set this back as it was an undesired side effect of dup
+
+  try
+    yes := $01010101;  {Copied this from existing code. Value is empiric,
+                    but works. (yes=true<>0) }
+    {$ifndef win32}
+      if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
+        raise ESocketException.create('unable to set socket options');
+      end;
+    {$endif}
+    localaddr := addr;
+    localport := port;
+    bindsocket;
+
+    if not udp then begin
+      {!!! allow custom queue length? default 5}
+      if listenqueue = 0 then listenqueue := 5;
+      If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise esocketexception.create('unable to listen');
+      state := wsListening;
+    end else begin
+      {$ifndef win32}
+        SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
+      {$endif}
+      state := wsconnected;
+    end;
+  finally
+    if state = wsclosed then begin
+      if fdhandlein >= 0 then begin
+        {one *can* get here without fd -beware}
+        eventcore.rmasterclr(fdhandlein);
+        myfdclose(fdhandlein); // we musnt leak file discriptors
+        eventcore.setfdreverse(fdhandlein,nil);
+        fdhandlein := -1;
+      end;
+    end else begin
+      eventcore.rmasterset(fdhandlein,true);
+    end;
+    if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
+  end;
+  //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); 
+end;
+
+function tlsocket.accept : longint;
+var
+  FromAddrSize     : LongInt;        // i don't realy know what to do with these at this
+  FromAddr         : TInetSockAddrV;  // at this point time will tell :)
+begin
+
+  FromAddrSize := Sizeof(FromAddr);
+  {$ifdef win32}
+    result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
+  {$else}
+    result := sockets.accept(fdhandlein,fromaddr,fromaddrsize);
+  {$endif}
+  //now we have accepted one request start monitoring for more again
+  eventcore.rmasterset(fdhandlein,true);
+
+  if result = -1 then raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting');
+  if result > absoloutemaxs then begin
+    myfdclose(result);
+    result := -1;
+    raise esocketexception.create('file discriptor out of range');
+  end;
+end;
+
+function tlsocket.sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer;
+var
+  destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute dest;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.sendto(self.fdhandleout,data^,len,0,destx,destlen);
+end;
+
+function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer;
+var
+  srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute src;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen);
+end;
+
+procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
+var
+  tempbuf:array[0..receivebufsize-1] of byte;
+begin
+  //writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger);
+  if (state =wslistening) and readtrigger then begin
+{    debugout('listening socket triggered on read');}
+    eventcore.rmasterclr(fdhandlein);
+    if assigned(onsessionAvailable) then onsessionAvailable(self,0);
+  end;
+  if udp and readtrigger then begin
+    if assigned(ondataAvailable) then ondataAvailable(self,0);
+    {!!!test}
+    exit;
+  end;
+  if (state =wsconnecting) and writetrigger then begin
+    // code for dealing with the reults of a non-blocking connect is
+    // rather complex
+    // if just write is triggered it means connect suceeded
+    // if both read and write are triggered it can mean 2 things
+    // 1: connect ok and data availible
+    // 2: connect fail
+    // to find out which you must read from the socket and look for errors
+    // there if we read successfully we drop through into the code for fireing
+    // the read event
+    if not readtrigger then begin
+      state := wsconnected;
+      if assigned(onsessionconnected) then onsessionconnected(self,0);
+    end else begin
+      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
+      if numread <> -1 then begin
+        state := wsconnected;
+        if assigned(onsessionconnected) then onsessionconnected(self,0);
+        //connectread := true;
+        recvq.add(@tempbuf,numread);
+      end else begin
+        state := wsconnected;
+        if assigned(onsessionconnected) then onsessionconnected(self,{$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});
+{        debugout('connect fail');}
+        self.internalclose(0);
+        recvq.del(maxlongint);
+      end;
+      // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
+      // so we drop down into the processing for data availible
+    end;
+    if fdhandlein >= 0 then begin
+      if state = wsconnected then begin
+        eventcore.rmasterset(fdhandlein,false);
+      end else begin
+        eventcore.rmasterclr(fdhandlein);
+      end;
+    end;
+    if fdhandleout >= 0 then begin
+      if sendq.size = 0 then begin
+        //don't clear the bit in fdswmaster if data is in the sendq
+        eventcore.wmasterclr(fdhandleout);
+      end;
+    end;
+
+  end;
+  inherited handlefdtrigger(readtrigger,writetrigger);
+end;
+
+constructor tlsocket.Create(AOwner: TComponent);
+begin
+  inherited create(aowner);
+  closehandles := true;
+end;
+
+
+function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
+var
+  addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
+begin
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.getpeername(self.fdhandlein,addrx,addrlen);
+end;
+
+procedure tlsocket.getxaddrbin(var binip:tbinip);
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  fillchar(addr,sizeof(addr),0);
+
+  {$ifdef win32}
+    winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
+  {$else}
+    sockets.getsocketname(self.fdhandlein,addr,i);
+  {$endif}
+  binip.family := addr.inaddr.family;
+  {$ifdef ipv6}
+  if addr.inaddr6.sin6_family = AF_INET6 then begin
+    binip.ip6 := addr.inaddr6.sin6_addr;
+  end else
+  {$endif}
+  begin
+    binip.ip := addr.inaddr.addr;
+  end;
+  converttov4(binip);
+end;
+
+procedure tlsocket.getpeeraddrbin(var binip:tbinip);
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  fillchar(addr,sizeof(addr),0);
+  {$ifdef win32}
+    winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
+  {$else}
+    sockets.getpeername(self.fdhandlein,addr,i);
+  {$endif}
+
+  binip.family := addr.inaddr.family;
+  {$ifdef ipv6}
+  if addr.inaddr6.sin6_family = AF_INET6 then begin
+    binip.ip6 := addr.inaddr6.sin6_addr;
+  end else
+  {$endif}
+  begin
+    binip.ip := addr.inaddr.addr;
+  end;
+  converttov4(binip);
+end;
+
+function tlsocket.getXaddr:string;
+var
+  biniptemp:tbinip;
+begin
+  getxaddrbin(biniptemp);
+  result := ipbintostr(biniptemp);
+  if result = '' then result := 'error';
+end;
+
+function tlsocket.getpeeraddr:string;
+var
+  biniptemp:tbinip;
+begin
+  getpeeraddrbin(biniptemp);
+  result := ipbintostr(biniptemp);
+  if result = '' then result := 'error';
+end;
+
+function tlsocket.getXport:string;
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  {$ifdef win32}
+    winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
+
+  {$else}
+    sockets.getsocketname(self.fdhandlein,addr,i);
+
+  {$endif}
+  result := inttostr(htons(addr.InAddr.port));
+end;
+
+function tlsocket.getpeerport:string;
+var
+  addr:tinetsockaddrv;
+  i:integer;
+begin
+  i := sizeof(addr);
+  {$ifdef win32}
+    winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
+
+  {$else}
+    sockets.getpeername(self.fdhandlein,addr,i);
+
+  {$endif}
+  result := inttostr(htons(addr.InAddr.port));
+end;
+
+{$ifdef win32}
+  procedure tlsocket.myfdclose(fd : integer);
+  begin
+    closesocket(fd);
+  end;
+  function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
+  begin
+    result := winsock.send(fd,(@buf)^,size,0);
+  end;
+  function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
+  begin
+    result := winsock.recv(fd,buf,size,0);
+  end;
+{$endif}
+
+end.
+
diff --git a/ltimevalstuff.inc b/ltimevalstuff.inc
new file mode 100755
index 0000000..0ac92cb
--- /dev/null
+++ b/ltimevalstuff.inc
@@ -0,0 +1,42 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+
+
+{add nn msec to tv}
+const
+  tv_invalidtimebig : ttimeval = (tv_sec:maxlongint;tv_usec:maxlongint);
+  //tv_invalidtimebig will always compare as greater than any valid timeval
+procedure tv_add(var tv:ttimeval;msec:integer);//{ $ifdef fpc}inline;{ $endif}
+begin
+  inc(tv.tv_usec,msec*1000);
+  inc(tv.tv_sec,tv.tv_usec div 1000000);
+  tv.tv_usec := tv.tv_usec mod 1000000;
+end;
+
+{tv1 >= tv2}
+function tv_compare(const tv1,tv2:ttimeval):boolean;//{ $ifdef fpc}inline;{ $endif}
+begin
+  if tv1.tv_sec = tv2.tv_sec then begin
+    result := tv1.tv_usec >= tv2.tv_usec;
+  end else result := tv1.tv_sec > tv2.tv_sec;
+end;
+
+procedure tv_substract(var tv:ttimeval;const tv2:ttimeval);//{ $ifdef fpc}inline;{ $endif}
+begin
+  dec(tv.tv_usec,tv2.tv_usec);
+  if tv.tv_usec < 0 then begin
+    inc(tv.tv_usec,1000000);
+    dec(tv.tv_sec)
+  end;
+  dec(tv.tv_sec,tv2.tv_sec);
+end;
+
+procedure msectotimeval(var tv:ttimeval;msec:integer);
+begin
+  tv.tv_sec := msec div 1000;
+  tv.tv_usec := (msec mod 1000)*1000;
+end;
+
diff --git a/pgtypes.pas b/pgtypes.pas
new file mode 100755
index 0000000..3c48e26
--- /dev/null
+++ b/pgtypes.pas
@@ -0,0 +1,20 @@
+{io core originally for linux bworld}
+
+{ 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
+  ----------------------------------------------------------------------------- }
+
+unit pgtypes;
+interface
+  type
+    {$ifdef cpu386}{$define i386}{$endif}
+    {$ifdef i386}
+      taddrint=longint;
+    {$else}
+      taddrint=sizeint;
+    {$endif}
+    paddrint=^taddrint;
+
+implementation
+end.
diff --git a/svn-commit.2.tmp b/svn-commit.2.tmp
new file mode 100755
index 0000000..82b4cd3
--- /dev/null
+++ b/svn-commit.2.tmp
@@ -0,0 +1,4 @@
+initial import
+--This line, and those below, will be ignored--
+
+A    .
diff --git a/svn-commit.3.tmp b/svn-commit.3.tmp
new file mode 100755
index 0000000..82b4cd3
--- /dev/null
+++ b/svn-commit.3.tmp
@@ -0,0 +1,4 @@
+initial import
+--This line, and those below, will be ignored--
+
+A    .
diff --git a/svn-commit.4.tmp b/svn-commit.4.tmp
new file mode 100755
index 0000000..6588c17
--- /dev/null
+++ b/svn-commit.4.tmp
@@ -0,0 +1,4 @@
+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
new file mode 100755
index 0000000..82b4cd3
--- /dev/null
+++ b/svn-commit.5.tmp
@@ -0,0 +1,4 @@
+initial import
+--This line, and those below, will be ignored--
+
+A    .
diff --git a/svn-commit.tmp b/svn-commit.tmp
new file mode 100755
index 0000000..82b4cd3
--- /dev/null
+++ b/svn-commit.tmp
@@ -0,0 +1,4 @@
+initial import
+--This line, and those below, will be ignored--
+
+A    .
diff --git a/uint32.inc b/uint32.inc
new file mode 100755
index 0000000..897db79
--- /dev/null
+++ b/uint32.inc
@@ -0,0 +1,14 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+type
+  {delphi 3 and before do not have a 32 bits unsigned integer type,
+  but longint has the correct behavior - it doesn't on newer delphi versions}
+  {$ifndef fpc}
+    {$ifdef ver70}{$define pred4}{$endif} {tp7}
+    {$ifdef ver80}{$define pred4}{$endif} {delphi 1}
+    {$ifdef ver90}{$define pred4}{$endif} {delphi 2}
+    {$ifdef ver100}{$define pred4}{$endif} {delphi 3}
+  {$endif}
+  uint32={$ifdef pred4}longint{$else}longword{$endif};
diff --git a/unixstuff.inc b/unixstuff.inc
new file mode 100755
index 0000000..76a7f52
--- /dev/null
+++ b/unixstuff.inc
@@ -0,0 +1,76 @@
+{$ifdef UNIX}
+  {$macro on}
+  {$ifdef VER1_0}
+    {$define tv_sec := sec}
+    {$define tv_usec := usec}
+    function dup(const original:integer):integer;inline;
+    begin
+      linux.dup(original,result);
+    end;
+    {$define gettimeofdaysec := gettimeofday}
+  {$else}
+    
+    {$define sigprocmask := fpsigprocmask}
+    {$define sigaction   := fpsigaction}
+    {$define fdclose     := fpclose}
+    {$define fcntl       := fpfcntl}
+    {$define fdwrite     := fpwrite}
+    {$define fdread      := fpread}
+    {$define fdopen      := fpopen}
+    {$define select      := fpselect}
+    {$define linuxerror  := fpgeterrno}
+    {$define fork        := fpfork}
+    {$define getpid      := fpgetpid}
+    {$define getenv      := fpgetenv}
+    {$define chmod       := fpchmod}
+    {$define dup2        := fpdup2}
+    {$ifndef ver1_9_2}
+      {$define flock     := fpflock}
+      {$ifndef ver1_9_4}
+        procedure Execl(Todo:string);inline;
+	var
+	  p : ppchar;
+	begin
+	  p := unixutil.StringToPPChar(Todo,1);
+	  if (p=nil) or (p^=nil) then exit;
+	  fpexecv(p^,p);
+	end;
+      {$endif}
+    {$endif}
+    procedure gettimeofday(var tv:ttimeval);inline;
+    begin
+      fpgettimeofday(@tv,nil);    
+    end;
+    function gettimeofdaysec : longint;
+    var
+      tv:ttimeval;
+    begin
+      gettimeofday(tv);
+      result := tv.tv_sec;
+    end;
+
+    //a function is used here rather than a define to prevent issues with tlasio.dup
+    function dup(const original:integer):integer;inline;
+    begin
+      result := fpdup(original);
+    end;
+    function octal(invalue:longint):longint;
+    var
+      a : integer;
+      i : integer;
+    begin
+      i := 0;
+      result := 0;
+      while invalue <> 0 do begin
+        a := invalue mod 10;
+        result := result + (a shl (i*3));
+
+        invalue := invalue div 10;
+        inc(i);
+      end;
+    end;
+    const
+      sys_eintr=esyseintr;
+
+  {$endif}
+{$endif}
diff --git a/wcore.pas b/wcore.pas
new file mode 100755
index 0000000..40505ef
--- /dev/null
+++ b/wcore.pas
@@ -0,0 +1,372 @@
+{ 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
+  ----------------------------------------------------------------------------- }
+
+unit wcore;
+
+{
+lcore compatible interface for windows
+
+- messageloop
+
+- tltimer
+
+}
+//note: events after release are normal and are the apps responsibility to deal with safely
+interface
+
+  uses
+    classes,windows,mmsystem;
+
+  type
+    float=double;
+
+    tlcomponent = class(tcomponent)
+    public
+      released:boolean;
+      procedure release;
+      destructor destroy; override;
+    end;
+
+    tltimer=class(tlcomponent)
+    public
+      ontimer:tnotifyevent;
+      initialevent:boolean;
+      initialdone:boolean;
+      prevtimer:tltimer;
+      nexttimer:tltimer;
+      interval:integer;        {miliseconds, default 1000}
+      enabled:boolean;
+      nextts:integer;
+      constructor create(aowner:tcomponent);override;
+      destructor destroy;override;
+    end;
+
+    ttaskevent=procedure(wparam,lparam:longint) of object;
+
+    tltask=class(tobject)
+    public
+      handler  : ttaskevent;
+      obj      : tobject;
+      wparam   : longint;
+      lparam   : longint;
+      nexttask : tltask;
+      constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+    end;
+
+procedure messageloop;
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+procedure disconnecttasks(aobj:tobject);
+procedure exitmessageloop;
+procedure processmessages;
+
+var
+  onshutdown:procedure(s:string);
+
+implementation
+
+uses
+  {$ifdef fpc}
+  bmessages;
+  {$else}
+  messages;
+  {$endif}
+
+
+const
+  WINMSG_TASK=WM_USER;
+
+var
+  hwndwcore:hwnd;
+  firsttimer:tltimer;
+  timesubstract:integer;
+  firsttask,lasttask,currenttask:tltask;
+
+procedure tlcomponent.release;
+begin
+  released := true;
+end;
+
+destructor tlcomponent.destroy;
+begin
+  disconnecttasks(self);
+  inherited destroy;
+end;
+
+{------------------------------------------------------------------------------}
+
+constructor tltimer.create;
+begin
+  inherited create(AOwner);
+  nexttimer := firsttimer;
+  prevtimer := nil;
+
+  if assigned(nexttimer) then nexttimer.prevtimer := self;
+  firsttimer := self;
+
+  interval := 1000;
+  enabled := true;
+  released := false;
+end;
+
+destructor tltimer.destroy;
+begin
+  if prevtimer <> nil then begin
+    prevtimer.nexttimer := nexttimer;
+  end else begin
+    firsttimer := nexttimer;
+  end;
+  if nexttimer <> nil then begin
+    nexttimer.prevtimer := prevtimer;
+  end;
+  inherited destroy;
+end;
+
+{------------------------------------------------------------------------------}
+
+function wcore_timehandler:integer;
+const
+  rollover_bits=30;
+var
+  tv,tvnow:integer;
+  currenttimer,temptimer:tltimer;
+begin
+  if not assigned(firsttimer) then begin
+    result := 1000;
+    exit;
+  end;
+
+  tvnow := timegettime;
+  if (tvnow and ((-1) shl rollover_bits)) <> timesubstract then begin
+    currenttimer := firsttimer;
+    while assigned(currenttimer) do begin
+      dec(currenttimer.nextts,(1 shl rollover_bits));
+      currenttimer := currenttimer.nexttimer;
+    end;
+    timesubstract := tvnow and ((-1) shl rollover_bits);
+  end;
+  tvnow := tvnow and ((1 shl rollover_bits)-1);
+
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    if tvnow >= currenttimer.nextts then begin
+      if assigned(currenttimer.ontimer) then begin
+        if currenttimer.enabled then begin
+          if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
+          currenttimer.initialdone := true;
+        end;
+      end;
+      currenttimer.nextts := tvnow+currenttimer.interval;
+    end;
+    temptimer := currenttimer;
+    currenttimer := currenttimer.nexttimer;
+    if temptimer.released then temptimer.free;
+  end;
+
+  tv := maxlongint;
+  currenttimer := firsttimer;
+  while assigned(currenttimer) do begin
+    if currenttimer.nextts < tv then tv := currenttimer.nextts;
+    currenttimer := currenttimer.nexttimer;
+  end;
+  result := tv-tvnow;
+  if result < 15 then result := 15;
+end;
+
+{------------------------------------------------------------------------------}
+
+constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  inherited create;
+  handler   := ahandler;
+  obj       := aobj;
+  wparam    := awparam;
+  lparam    := alparam;
+  {nexttask  := firsttask;
+  firsttask := self;}
+  if assigned(lasttask) then begin
+    lasttask.nexttask := self;
+  end else begin
+    firsttask := self;
+    postmessage(hwndwcore,WINMSG_TASK,0,0);
+  end;
+  lasttask := self;
+  //ahandler(wparam,lparam);
+end;
+
+procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
+begin
+  tltask.create(ahandler,aobj,awparam,alparam);
+end;
+
+procedure disconnecttasks(aobj:tobject);
+var
+  currenttasklocal : tltask ;
+  counter          : byte   ;
+begin
+  for counter := 0 to 1 do begin
+    if counter = 0 then begin
+      currenttasklocal := firsttask; //main list of tasks
+    end else begin
+      currenttasklocal := currenttask; //needed in case called from a task
+    end;
+    // note i don't bother to sestroy the links here as that will happen when
+    // the list of tasks is processed anyway
+    while assigned(currenttasklocal) do begin
+      if currenttasklocal.obj = aobj then begin
+        currenttasklocal.obj := nil;
+        currenttasklocal.handler := nil;
+      end;
+      currenttasklocal := currenttasklocal.nexttask;
+    end;
+  end;
+end;
+
+procedure dotasks;
+var
+  temptask:tltask;
+begin
+  if firsttask = nil then exit;
+
+  currenttask := firsttask;
+  firsttask := nil;
+  lasttask  := nil;
+  while assigned(currenttask) do begin
+    if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
+    temptask := currenttask;
+    currenttask := currenttask.nexttask;
+    temptask.free;
+  end;
+  currenttask := nil;
+end;
+
+{------------------------------------------------------------------------------}
+
+procedure exitmessageloop;
+begin
+  postmessage(hwndwcore,WM_QUIT,0,0);
+end;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+const timerid_wcore=$1000;
+  {$endif}
+
+function MyWindowProc(
+    ahWnd   : HWND;
+    auMsg   : Integer;
+    awParam : WPARAM;
+    alParam : LPARAM): Integer; stdcall;
+var
+    MsgRec : TMessage;
+    a:integer;
+begin
+  Result := 0;  // This means we handled the message
+
+  {MsgRec.hwnd    := ahWnd;}
+  MsgRec.wParam  := awParam;
+  MsgRec.lParam  := alParam;
+
+  dotasks;
+  case auMsg of
+    {$ifndef threadtimer}
+    WM_TIMER: begin
+      if msgrec.wparam = timerid_wcore then begin
+        a := wcore_timehandler;
+        killtimer(hwndwcore,timerid_wcore);
+        settimer(hwndwcore,timerid_wcore,a,nil);
+      end;
+    end;
+    {$endif}
+
+    {WINMSG_TASK:dotasks;}
+
+    WM_CLOSE: begin
+      {}
+    end;
+    WM_DESTROY: begin
+      {}
+    end;
+  else
+      Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
+  end;
+end;
+
+
+var
+  MyWindowClass : TWndClass = (style         : 0;
+                                 lpfnWndProc   : @MyWindowProc;
+                                 cbClsExtra    : 0;
+                                 cbWndExtra    : 0;
+                                 hInstance     : 0;
+                                 hIcon         : 0;
+                                 hCursor       : 0;
+                                 hbrBackground : 0;
+                                 lpszMenuName  : nil;
+                                 lpszClassName : 'wcoreClass');
+
+procedure messageloop;
+var
+  MsgRec : TMsg;
+begin
+
+  if Windows.RegisterClass(MyWindowClass) = 0 then halt;
+  //writeln('about to create wcore handle, hinstance=',hinstance);
+  hwndwcore := CreateWindowEx(WS_EX_TOOLWINDOW,
+                               MyWindowClass.lpszClassName,
+                               '',        { Window name   }
+                               WS_POPUP,  { Window Style  }
+                               0, 0,      { X, Y          }
+                               0, 0,      { Width, Height }
+                               0,         { hWndParent    }
+                               0,         { hMenu         }
+                               HInstance, { hInstance     }
+                               nil);      { CreateParam   }
+
+  if hwndwcore = 0 then halt;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+  if settimer(hwndwcore,timerid_wcore,15,nil) = 0 then halt;
+  {$endif}
+
+
+  while GetMessage(MsgRec, 0, 0, 0) do begin
+    TranslateMessage(MsgRec);
+    DispatchMessage(MsgRec);
+    {if not peekmessage(msgrec,0,0,0,PM_NOREMOVE) then onidle}
+  end;
+
+  if hWndwcore <> 0 then begin
+    DestroyWindow(hwndwcore);
+    hWndwcore := 0;
+  end;
+
+  {$ifdef threadtimer}
+  'thread timer'
+  {$else}
+  killtimer(hwndwcore,timerid_wcore);
+  {$endif}
+end;
+
+function ProcessMessage : Boolean;
+var
+    Msg : TMsg;
+begin
+    Result := FALSE;
+    if PeekMessage(Msg, hwndwcore, 0, 0, PM_REMOVE) then begin
+      Result := TRUE;
+      DispatchMessage(Msg);
+    end;
+end;
+
+procedure processmessages;
+begin
+  while processmessage do;
+end;
+
+
+end.