From ec281299480f302f4a48a74c877e658b43b25b7b Mon Sep 17 00:00:00 2001
From: =?utf8?q?Tom=C3=A1=C5=A1=20Brada?= <tomasbrod@azet.sk>
Date: Sun, 13 Dec 2015 13:47:55 +0100
Subject: [PATCH] work.

---
 TestDHT.pas    | 10 ++++++++--
 dht.pas        | 44 ++++++++++++++++++++++++++++++++++++++------
 dhtWebBoot.pas | 39 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 85 insertions(+), 8 deletions(-)
 create mode 100644 dhtWebBoot.pas

diff --git a/TestDHT.pas b/TestDHT.pas
index 55f9e74..09234a1 100644
--- a/TestDHT.pas
+++ b/TestDHT.pas
@@ -2,22 +2,28 @@ unit TestDHT;
 
 INTERFACE
 IMPLEMENTATION
-USES ServerLoop,NetAddr,SysUtils,DHT;
+USES ServerLoop,NetAddr,SysUtils,DHT,dhtWebBoot;
 type t=object
  procedure init;
 end;
 procedure t.init;
  var oi:word;
  const opt='-test-dht';
+ const opt2='-test-boot';
  var addr:tNetAddr;
  begin
  oi:=OptIndex(opt);
  if oi>0 then begin
-  assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr fid:sha1)');
+  assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr)');
   addr:=paramstr(oi+1);
   writeln('TestDHT: rcpt '+paramstr(oi+1));
   DHT.NodeBootstrap(addr);
  end;
+ oi:=OptIndex(opt2);
+ if oi>0 then begin
+  assert(OptParamCount(oi)=1,opt2+'(url)');
+  Bootstrap(paramstr(oi+1));
+ end;
 end;
 
 var o:t;
diff --git a/dht.pas b/dht.pas
index 65ddbd2..cb70a37 100644
--- a/dht.pas
+++ b/dht.pas
@@ -26,6 +26,7 @@ type
    LastMsgFrom,
    LastResFrom  :tMTime;
  end;
+ tPeer_ptr=^tPeer;
  tBucket_ptr=^tBucket;
  tBucket=object
    Prefix: tPID;
@@ -179,6 +180,21 @@ procedure UpdateNode(const id:tFID; const addr:tNetAddr);
  end;
 end;
 
+procedure GetNextNode(var ibkt:tBucket_ptr; var ix:byte; const id:tPID);
+ var bkt:^tBucket;
+ begin
+ bkt:=ibkt;
+ repeat
+  inc(ix);
+  if ix>high(tBucket.peer) then begin
+   ix:=1;
+   bkt:=bkt^.next;
+   if not assigned(bkt) then break;
+  end;
+ until (not bkt^.peer[ix].Addr.isNil)and(bkt^.peer[ix].ReqDelta<3);
+ ibkt:=bkt;
+end;
+
 procedure RecvRequest(msg:tSMsg);
  var s:tMemoryStream absolute msg.stream;
  var hID:^tPID;
@@ -194,6 +210,8 @@ procedure RecvRequest(msg:tSMsg);
  caps:=s.ReadByte;
  writeln('DHT: ',string(msg.source^),' Request for ',string(rID^));
  UpdateNode(hID^,msg.source^);
+ {Select peers only from The bucket,
+  if it is broken, send none, but still Ack}
  bkt:=FindBucket(rID^);
  r.Init(128);
  if assigned(bkt) then begin
@@ -284,8 +302,14 @@ end;
 
 procedure tBucket.Refresh;
  var my,rtr:boolean;
- var i,ol:byte;
+ var i,ol,rv:byte;
  var wait:LongWord;
+ var rvb:^tBucket;
+ procedure lSend(var peer:tPeer; const trg:tPID);
+  begin
+  SendRequest(peer.Addr,trg,0);
+  Inc(peer.ReqDelta);
+ end;
  begin
  my:=MatchPrefix(MyID);
  ol:=0;
@@ -295,18 +319,26 @@ procedure tBucket.Refresh;
    if peer[i].ReqDelta>0 then begin
     {peer is not responding, but try once more}
     writeln('DHT: Refresh (R',peer[i].ReqDelta,') #',i,' ',string(peer[i].addr));
-    SendRequest(peer[i].Addr,prefix,0);
-    inc(peer[i].ReqDelta);
+    lSend(peer[i],prefix);
     rtr:=true;
    end
    else if (ol=0) or (peer[i].LastMsgFrom<peer[ol].LastMsgFrom)
         then ol:=i;
   end;
- {TODO: pick ol random}
+ {now nudge the most quiet peer}
  if (ol>0) and (not rtr) then begin
   if not rtr then writeln('DHT: Refresh (T',mNow-peer[ol].LastMsgFrom,') #',ol,' ',string(peer[ol].addr));
-  SendRequest(peer[ol].Addr,MyID,0);
-  inc(peer[ol].ReqDelta);
+  lSend(peer[ol],MyID);
+ end;
+ if (not rtr)and(ol=0) then begin
+  {no usable nodes in this bucket, try to recover from other buckets}
+  writeln('DHT: Refresh BROKEN BUCKET');
+  rv:=0; rvb:=@self;
+  GetNextNode(rvb,rv,prefix);
+  if assigned(rvb) then begin
+   writeln('DHT: Refresh (RV) #',rv,' ',string(rvb^.peer[rv].addr));
+   lSend(rvb^.peer[rv],prefix);
+  end;
  end;
  if my
   then wait:=18000+(depth*600)
diff --git a/dhtWebBoot.pas b/dhtWebBoot.pas
new file mode 100644
index 0000000..f517ce9
--- /dev/null
+++ b/dhtWebBoot.pas
@@ -0,0 +1,39 @@
+unit dhtWebBoot;
+
+INTERFACE
+
+procedure Bootstrap(url:ansistring);
+
+IMPLEMENTATION
+uses sockets,netdb,uriparser,NetAddr;
+
+type t=object
+ s:tSocket;
+ procedure Init(url:ansistring);
+end;
+
+procedure t.Init(url:ansistring);
+ var uri:tURI;
+ var he:tHostEntry;
+ var addr:tNetAddr;
+ begin
+ uri:=ParseURI(url);
+ if uri.port=0 then uri.port:=80;
+ uri.path:=uri.path+uri.document;
+ writeln('Boot: ',uri.host,' ',uri.port,' ',uri.path,' ',uri.params);
+ if NetDB.ResolveHostByName(uri.host,he) then begin
+  addr.data.family:=afInet;
+  addr.data.inet.addr:=he.Addr;
+  addr.data.inet.port:=htons(uri.port);
+  writeln('Boot: ',string(addr)+'/'+uri.path+'?'+uri.params);
+ end else writeln('fuck');
+end;
+
+procedure Bootstrap(url:ansistring);
+ var o:^t;
+ begin
+ New(o);
+ o^.Init(url);
+end;
+
+END.
\ No newline at end of file
-- 
2.11.4.GIT