2 {Challenge-Response Authenticator}
4 USES NetAddr
,ECC
,SHA1
,Chat
,ServerLoop
,MemStream
,opcode
;
13 Callback
:procedure of object;
14 procedure Init(const iRemote
:tNetAddr
);
17 procedure ReplyRes(msg
:tSMsg
; data
:boolean);
18 procedure ReplyPow(msg
:tSMsg
; data
:boolean);
26 procedure tAuth
.Init(const iRemote
:tNetAddr
);
29 Assert(assigned(Callback
) and (not iRemote
.isNil
));
35 Ch
.OnTimeout
:=@Timeout
;
36 Ch
.Callback
:=@ReplyRes
;
37 Ch
.SetTimeout(8001,3000);
38 {generate and send challenge}
40 ECC
.CreateChallenge(challenge
);
41 Ms
.WriteByte(opcode
.crAuthReq
);
43 Ms
.Write(ECC
.PublicKey
,sizeof(PublicKey
));
44 Ms
.Write(challenge
,sizeof(challenge
));
48 procedure tAuth
.ReplyRes(msg
:tSMsg
; data
:boolean);
49 var r
:tMemoryStream
absolute msg
.Stream
;
52 var vresp
:tSha1Digest
;
54 if not data
then exit
;
55 status
:=r
.readbyte
; {todo, set error (eg: unsuported meth)}
56 r
.Read(RemotePub
,sizeof(tEccKey
));
57 resp
:=r
.readptr(sizeof(tEccKey
));
58 ECC
.CreateResponse(Challenge
,vresp
,RemotePub
);
59 Valid
:=CompareByte(resp
^,vresp
,sizeof(vresp
))=0;
60 if (status
and 128)>0 then begin
62 Ch
.Callback
:=@ReplyPow
;
66 procedure tAuth
.ReplyPow(msg
:tSMsg
; data
:boolean);
67 var r
:tMemoryStream
absolute msg
.Stream
;
68 var ptp
:byte;{Proof TyPe}
71 if not data
then exit
;
72 ptp
:=r
.readbyte
; {todo}
73 nonce
:=r
.ReadPtr(sizeof(tPoWRec
));
74 PoWValid
:=VerifyPoW(nonce
^,RemotePub
);
77 procedure tAuth
.Timeout
;
83 procedure tAuth
.Conclusion
;
88 ms
.WriteByte(byte(Valid
));
89 ms
.WriteByte(byte(PowValid
));
97 FreeMem(@self
,sizeof(self
));
103 procedure SendRep(msg
:tSMsg
; data
:boolean);
104 procedure SendPow(msg
:tSMsg
; data
:boolean);
105 procedure Last(msg
:tSMsg
; data
:boolean);
109 procedure AuthHandler(var ch
:tChat
; msg
:tSMsg
);
112 msg
.stream
.skip(1); {initcode}
115 ch
.OnTimeout
:=@srv
^.Close
;
116 srv
^.SendRep(msg
,true);
123 procedure tServer
.SendRep(msg
:tSMsg
; data
:boolean);
124 var r
:tMemoryStream
absolute msg
.Stream
;
125 var ms
:tMemoryStream
;
128 var resp
:tSha1Digest
;
130 ver
:=r
.ReadByte
; {todo}
131 r
.Read(pub
,sizeof(pub
));
132 chal
:=r
.readptr(sizeof(tEccKey
));
133 CreateResponse(chal
^,resp
,pub
);
134 ch
^.StreamInit(ms
,66); {todo}
136 ms
.Write(PublicKey
,sizeof(PublicKey
));
137 ms
.Write(resp
,sizeof(resp
));
138 ch
^.Callback
:=@SendPoW
;
139 ch
^.SetTimeout(8000,0);{no reply expected}
143 procedure tServer
.SendPow(msg
:tSMsg
; data
:boolean);
144 var ms
:tMemoryStream
;
147 ch
^.StreamInit(ms
,66); {todo}
149 ms
.Write(PublicPoW
,sizeof(PublicPoW
));
151 ch
^.SetTimeout(8000,2000);
155 procedure tServer
.Last(msg
:tSMsg
; data
:boolean);
156 var r
:tMemoryStream
absolute msg
.Stream
;
157 var Valid
,ValidPoW
:byte;
159 if not data
then exit
; {unlikely}
161 ValidPoW
:=r
.ReadByte
;
162 if (Valid
<>1)or(ValidPoW
<>1) then begin
163 write('CRAuth: Our auth failed on remote, reason pub=',Valid
,' pow=',ValidPoW
);
164 Writeln(' remote ',string(ch
^.remote
),' ',string(pub
));
168 procedure tServer
.Close
;
171 FreeMem(@self
,sizeof(self
));
174 procedure tAuth
.Cancel
;
181 SetChatHandler(opcode
.crAuthReq
,@AuthHandler
);