1{$mode objfpc}
2{$H+}
3unit macuuid;
4
5Interface
6
7uses SysUtils;
8
9Function CreateMacGUID(Out GUID : TGUID) : Integer;
10
11
12Implementation
13
14uses unixtype, sockets, baseunix, unix;
15
16Const
17  MAX_ADJUSTMENT = 10;
18  IPPROTO_IP     = 0;
19//  AF_INET        = 2;
20//  SOCK_DGRAM     = 2;
21  IF_NAMESIZE    = 16;
22  SIOCGIFCONF    = $8912;
23  SIOCGIFHWADDR  = $8927;
24
25Type
26  {$packrecords c}
27  tifr_ifrn = record
28    case integer of
29      0 : (ifrn_name: array [0..IF_NAMESIZE-1] of char);
30  end;
31  tifmap = record
32    mem_start : culong;
33    mem_end   : culong;
34    base_addr : cushort;
35    irq       : cuchar;
36    dma       : cuchar;
37    port      : cuchar;
38  end;
39  PIFrec = ^TIFrec;
40  TIFrec = record
41    ifr_ifrn : tifr_ifrn;
42    case integer of
43      0 : (ifru_addr      : TSockAddr);
44      1 : (ifru_dstaddr   : TSockAddr);
45      2 : (ifru_broadaddr : TSockAddr);
46      3 : (ifru_netmask   : TSockAddr);
47      4 : (ifru_hwaddr    : TSockAddr);
48      5 : (ifru_flags     : cshort);
49      6 : (ifru_ivalue    : cint);
50      7 : (ifru_mtu       : cint);
51      8 : (ifru_map       : tifmap);
52      9 : (ifru_slave     : Array[0..IF_NAMESIZE-1] of char);
53      10 : (ifru_newname  : Array[0..IF_NAMESIZE-1] of char);
54      11 : (ifru_data     : pointer);
55  end;
56  TIFConf = record
57    ifc_len : cint;
58    case integer of
59      0 : (ifcu_buf : pointer);
60      1 : (ifcu_req : ^tifrec);
61  end;
62
63  tuuid = record
64    time_low : cardinal;
65    time_mid : Word;
66    time_hi_and_version : Word;
67    clock_seq : Word;
68    node : Array[0..5] of byte;
69  end;
70
71Var
72  MacAddr      : Packed Array[1..6] of byte = (0,0,0,0,0,0);
73  MacAddrTried : Byte = 0 ;
74  Last   : TTimeVal = (tv_sec:0;tv_usec:0);
75  ClockSeq   : Word = 0;
76  AdjustMent : Integer = 0;
77
78Procedure GetRandomBytes(Var Buf; NBytes : Integer);
79
80Var
81  I : Integer;
82  P : PByte;
83
84begin
85  P:=@Buf;
86  Randomize;
87  For I:=0 to NBytes-1 do
88    P[i]:=Random(256);
89end;
90
91Function GetMacAddr : Boolean;
92
93var
94  i,j,n,Sd : Integer;
95  buf : Array[0..1023] of byte;
96  ifc : TIfConf;
97  ifr : TIFRec;
98  ifp : PIFRec;
99  p   : PChar;
100begin
101  Result:=MacAddrTried>0;
102  If Result then
103    Result:=MacAddrTried>1
104  else
105    begin
106    MacAddrTried:=1;
107    sd:=fpSocket(AF_INET,SOCK_DGRAM,IPPROTO_IP);
108    if (sd<0) then
109      exit;
110    Try
111      ifc.ifc_len:=Sizeof(Buf);
112      ifc.ifcu_buf:=@buf;
113      if fpioctl(sd, SIOCGIFCONF, @ifc)<0 then
114        Exit;
115      n:= ifc.ifc_len;
116      i:=0;
117      While (Not Result) and (I<N) do
118        begin
119        ifp:=PIFRec(PByte(ifc.ifcu_buf)+i);
120        move(ifp^.ifr_ifrn.ifrn_name,ifr.ifr_ifrn.ifrn_name,IF_NAMESIZE);
121        if (fpioctl(sd, SIOCGIFHWADDR, @ifr) >= 0) then
122          begin
123          P:=Pchar(@ifr.ifru_hwaddr.sa_data);
124          Result:=(p[0]<>#0) or (p[1]<>#0) or (p[2]<>#0)
125                  or (p[3]<>#0) or (p[4]<>#0) or (p[5]<>#0);
126          If Result Then
127            begin
128            Move(P^,MacAddr,SizeOf(MacAddr));
129            MacAddrTried:=2;
130            // DumpMacAddr;
131            end;
132          end;
133        I:=I+sizeof(tifrec);
134        end;
135    Finally
136      fileClose(sd);
137    end;
138    end;
139end;
140
141
142Function GetClock(Var ClockHigh,ClockLow : Cardinal; Var RetClockSeq : Word) : boolean;
143
144Var
145  TV       : TTImeVal;
146  ClockReg : QWord;
147  OK       : Boolean;
148
149begin
150  OK:=True;
151  Repeat
152    FPGetTimeOfDay(@Tv,Nil);
153    If (Last.tv_sec=0) and (last.tv_sec=0) then
154      begin
155      GetRandomBytes(ClockSeq,SizeOf(ClockSeq));
156      ClockSeq:=ClockSeq and $1FFF;
157      last:=TV;
158      Dec(last.tv_sec);
159      end;
160    if (tv.tv_sec<last.tv_sec) or
161        ((tv.tv_sec=last.tv_sec) and (tv.tv_usec<last.tv_usec)) then
162      begin
163      ClockSeq:=(ClockSeq+1) and $1FFF;
164      Adjustment:=0;
165      Last:=Tv;
166      end
167    else if (tv.tv_sec=last.tv_sec) and (tv.tv_usec=last.tv_usec) then
168      begin
169      If Adjustment>=MAX_ADJUSTMENT then
170        OK:=False
171      else
172        inc(AdjustMent);
173      end
174    else
175      begin
176      AdjustMent:=0;
177      Last:=tv;
178      end;
179  Until OK;
180  ClockReg:=tv.tv_usec*10+adjustment;
181  Inc(ClockReg,tv.tv_sec*10000000);
182  Inc(ClockReg,($01B21DD2 shl 32) + $13814000);
183  ClockHigh   :=Hi(ClockReg);
184  ClockLow    :=Lo(ClockReg);
185  RetClockSeq :=ClockSeq;
186  Result      :=True;
187end;
188
189Procedure UUIDPack(Const UU : TUUID; Var GUID : TGUID);
190
191Var
192  tmp : Cardinal;
193  P   : PByte;
194
195begin
196  P:=PByte(@GUID);
197
198  tmp:=uu.time_low;
199  P[3]:=tmp and $FF;
200  tmp:=tmp shr 8;
201  P[2]:=tmp and $FF;
202  tmp:=tmp shr 8;
203  P[1]:=tmp and $FF;
204  tmp:=tmp shr 8;
205  P[0]:=tmp and $FF;
206
207  tmp:=uu.time_mid;
208  P[5]:=tmp and $FF;
209  tmp:=tmp shr 8;
210  P[4]:=tmp and $FF;
211
212  tmp:=uu.time_hi_and_version;
213  P[7]:=tmp and $FF;
214  tmp:=tmp shr 8;
215  P[6]:=tmp and $FF;
216
217  tmp:=uu.clock_seq;
218  P[9]:=tmp and $FF;
219  tmp:=tmp shr 8;
220  P[8]:=tmp and $FF;
221
222  Move(uu.node,P[10],6);
223end;
224
225Procedure DumpMacAddr;
226
227var
228  I : Integer;
229begin
230  Write('Mac Addr: ');
231  For i:=1 to 6 do
232    write(hexstr(MacAddr[i],2),':');
233end;
234
235Function CreateMacGUID(Out GUID : TGUID) : Integer;
236
237Var
238  UU       : TUUId;
239  ClockMid : Cardinal;
240
241begin
242  Result:=Ord(not GetMacAddr);
243  If (Result=0) then
244    begin
245    // DumpMacAddr;
246    // Writeln;
247    GetClock(ClockMid,uu.time_low,uu.clock_seq);
248    uu.Clock_seq:=uu.Clock_seq or $8000;
249    uu.time_mid:=lo(clockMid);
250    uu.time_hi_and_version:=hi(ClockMid) or $1000;
251    move(MacAddr,uu.node,sizeof(MacAddr));
252    UUIDPack(UU,GUID);
253    end;
254end;
255
256initialization
257  OnCreateGUID:=@CreateMacGUID;
258end.
259