system without ipv6 enabled using delphi 3
* make failures to create the socket go through the async error
handling system so they interact well with the address list
system (making use of an address list with mixed v4 and v6
addresses work on a v4 only system)
* fixup some unit dependencies
* fixup some bits in the test app itself, make the test app able to
complete on a system without ipv6 enabled, make the test app
buildable on windows.
* fixup handling of blank and unknown protocols (blank gives TCP,
unknown gives an error)
* disable word size check in lcorerng
* make some stuff that really shouldn't be pulic private, more should
probablly be done later in this regard
git-svn-id: file:///svnroot/lcore/trunk@32
b1de8a11-f9be-4011-bde0-
cc7ace90066a
procedure tlasio.internalclose(error:word);\r
begin\r
if (state<>wsclosed) and (state<>wsinvalidstate) then begin\r
+ // -2 is a special indication that we should just exist silently\r
+ // (used for connect failure handling when socket creation fails)\r
+ if (fdhandlein = -2) and (fdhandleout = -2) then exit;\r
if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');\r
eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);\r
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
\r
{$ifndef nolcorernd}\r
uses\r
- {$ifdef win32}windows,activex,types,{$endif}\r
+ {$ifdef win32}windows,activex,{$endif}\r
{$ifdef unix}baseunix,unix,unixutil,{$endif}\r
fastmd5,sysutils;\r
\r
const\r
wordsizeshift=2;\r
wordsize=1 shl wordsizeshift;\r
-\r
- {$if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{$ifend}\r
-\r
+ //wordsize check commented out for d3 compatibility\r
+ //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}\r
hashsize=sizeof(hashtype);\r
halfhashsize=hashsize div 2;\r
hashdwords=hashsize div wordsize;\r
dnsasync,\r
binipstuff,\r
sysutils,\r
- dnssync,\r
+ dnssync\r
//we don't actually make any use of the units below in this app, we just\r
//include it to check if it compiles ok ;)\r
- lmessages,\r
- unitfork;\r
+ {$ifndef win32}\r
+ ,\r
+ lmessages,\r
+ unitfork\r
+ {$endif}\r
+ ;\r
{$ifdef win32}\r
{$R *.RES}\r
{$endif}\r
clientsocket : tlsocket;\r
sc : tsc;\r
task : tltask;\r
+ firststage : boolean;\r
procedure tsc.sessionavailable(sender: tobject;error : word);\r
begin\r
writeln('received connection');\r
\r
procedure tsc.sessionconnected(sender: tobject;error : word);\r
begin\r
- \r
+\r
if error=0 then begin\r
writeln('session is connected, local address is'+clientsocket.getxaddr);\r
\r
- if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin\r
+ if firststage then begin\r
clientsocket.sendstr('hello world');\r
end else begin\r
clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);\r
writeln('closing client socket');\r
clientsocket.close;\r
\r
- writeln('looking up irc.ipv6.p10link.net using dnsasync');\r
+ writeln('looking up irc.p10link.net using dnsasync');\r
das := tdnsasync.Create(nil);\r
das.onrequestdone := sc.dnsrequestdone;\r
//das.forwardfamily := af_inet6;\r
- das.forwardlookup('irc.ipv6.p10link.net');\r
- \r
+ das.forwardlookup('irc.p10link.net');\r
+\r
end;\r
\r
procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
tempbinip : tbinip;\r
tempbiniplist : tbiniplist;\r
begin\r
- writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
+ writeln('irc.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
das.dnsresultbin(tempbinip);\r
tempbiniplist := biniplist_new;\r
biniplist_add(tempbiniplist,tempbinip);\r
clientsocket.addr := tempbiniplist;\r
clientsocket.port := '6667';\r
+ firststage := false;\r
clientsocket.connect;\r
//writeln(clientsocket.getxaddr);\r
das.free;\r
timer : tltimer;\r
ipbin : tbinip;\r
dummy : integer;\r
+ iplist : tbiniplist;\r
begin\r
+ lcoreinit;\r
ipbin := forwardlookup('invalid.domain',5);\r
writeln(ipbintostr(ipbin));\r
\r
writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));\r
writeln('creating and setting up listen socket');\r
listensocket := tlsocket.create(nil);\r
- listensocket.addr := '::';\r
+ listensocket.addr := '';\r
listensocket.port := '12345';\r
listensocket.onsessionavailable := sc.sessionavailable;\r
writeln('listening');\r
serversocket.ondataavailable := sc.dataavailable;\r
writeln('creating and setting up client socket');\r
clientsocket := tlsocket.create(nil);\r
- clientsocket.addr := '::1';{'127.0.0.1';}\r
+ //try connecting to ::1 first and if that fails try 127.0.0.1\r
+ iplist := biniplist_new;\r
+ ipstrtobin('::1',ipbin);\r
+ biniplist_add(iplist,ipbin);\r
+ ipstrtobin('127.0.0.1',ipbin);\r
+ biniplist_add(iplist,ipbin);\r
+ clientsocket.addr := iplist;\r
clientsocket.port := '12345';\r
clientsocket.onsessionconnected := sc.sessionconnected;\r
clientsocket.ondataAvailable := sc.dataavailable;\r
clientsocket.onsessionclosed := sc.sessionclosed;\r
writeln('connecting');\r
+ firststage := true;\r
clientsocket.connect;\r
writeln('client socket is number ',clientsocket.fdhandlein);\r
writeln('creating and setting up timer');\r
which is included in the package\r
----------------------------------------------------------------------------- }\r
\r
+//this unit provides a rough approximation of windows messages on linux\r
+//it is usefull for multithreaded applications on linux to communicate back to\r
+//the main lcore thread\r
+//This unit is *nix only, on windows you should use the real thing\r
+\r
unit lmessages;\r
//windows messages like system based on lcore tasks\r
interface\r
procedure secondaccepthandler(sender:tobject;error:word);\r
procedure internalclose(error:word);override;\r
{$endif}\r
- procedure connectionfailedhandler(error:word);\r
- procedure connecttimeouthandler(sender:tobject);\r
- procedure connectsuccesshandler;\r
function getaddrsize:integer;\r
procedure connect; virtual;\r
procedure realconnect;\r
function getXport:string; virtual;\r
function getpeerport:string; virtual;\r
constructor Create(AOwner: TComponent); override;\r
+\r
+ //this one has to be kept public for now because lcorewsaasyncselect calls it\r
+ procedure connectionfailedhandler(error:word);\r
+ private\r
+ procedure taskcallconnectionfailedhandler(wparam,lparam : longint);\r
+\r
+ procedure connecttimeouthandler(sender:tobject);\r
+ procedure connectsuccesshandler;\r
{$ifdef win32}\r
procedure myfdclose(fd : integer); override;\r
function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;\r
var\r
a,b:integer;\r
begin\r
-// writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);\r
+ //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);\r
makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr);\r
inc(currentip);\r
if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;\r
a := SOCK_DGRAM;\r
udp := true;\r
dgram := true;\r
- end else if (uppercase(proto) = 'TCP') then begin\r
+ end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin\r
b := IPPROTO_TCP;\r
a := SOCK_STREAM;\r
dgram := false;\r
- end else begin\r
+ end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin\r
+ //note: ICMP support doesn't seem to work yet\r
b := strtointdef(proto,IPPROTO_ICMP);\r
a := SOCK_RAW;\r
dgram := true;\r
+ end else begin\r
+ raise ESocketException.create('unrecognised protocol');\r
end;\r
\r
a := Socket(inaddr.inaddr.family,a,b);\r
//writeln(ord(inaddr.inaddr.family));\r
if a = -1 then begin\r
- lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};\r
- raise esocketexception.create('unable to create socket');\r
+ //unable to create socket, fire an error event (better to use an error event\r
+ //to avoid poor interaction with multilistener stuff.\r
+ //a socket value of -2 is a special value to say there is no socket but\r
+ //we want internalclose to act as if there was\r
+ fdhandlein := -2;\r
+ fdhandleout := -2;\r
+ tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0);\r
+ exit;\r
end;\r
try\r
dup(a);\r
end;\r
{$endif}\r
\r
- if fdhandlein = -1 then raise ESocketException.create('unable to create socket');\r
+ if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif});\r
dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things\r
//eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup\r
state := wsclosed; // then set this back as it was an undesired side effect of dup\r
if not udp then begin\r
{!!! allow custom queue length? default 5}\r
if listenqueue = 0 then listenqueue := 5;\r
- If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise \r
+ If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise\r
esocketexception.create('unable to listen');\r
state := wsListening;\r
end else begin\r
srclen := tempsrclen;\r
end;\r
\r
+procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);\r
+begin\r
+ connectionfailedhandler(wparam);\r
+end;\r
+\r
procedure tlsocket.connectionfailedhandler(error:word);\r
begin\r
if trymoreips then begin\r