1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:

program ntpupdate;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  DateUtils,
  Libc;

type
  TNtpUpdate = class(TObject)
    procedure Run;
  end;

procedure TNtpUpdate.Run;
var
  hSocket: TSocket;
  time: Cardinal;
  hostent: PHostEnt;
  addr: TSockAddrIn;
  error: Integer;
  dt: TDateTime;
  ut: TUnixTime;
  tv: TTimeVal;
  tz: TTimeZone;
  delay: clock_t;
begin
  openlog('ntpupdate', LOG_NOWAIT, LOG_DAEMON);
  SysLog(LOG_INFO, 'ntpupdate: Start as Daemon');

  if fork > 0 then 
  begin
    SysLog(LOG_ERR, 'ntpupdate: Can''t create child process');
    Exit;
  end;

  FileClose(0); // Datei-Descriptoren für Standardeingabe, Standardausgabe
  FileClose(1); // und Standardfehler des Elternprozesses schließen,
  FileClose(2); // sonst kann es zu Programmabstürzen kommen

  hSocket := socket(AF_INET, SOCK_STREAM, 0);
  if hSocket = INVALID_SOCKET then
  begin
    SysLog(LOG_ERR, 'ntpupdate: Can''t create a socket');
    Exit;
  end;

  addr.sin_family := AF_INET;
  addr.sin_port := htons(37);

  // Als Zeitserver kommen alle in Frage, die über Port 37 operieren
  // Nach Möglichkeit den nächstgelegenen verwenden 
  // Dieser sollte allerdings ein existierender sein ;)
  hostent := GetHostByName('ntpserv.fh-magdeburg.de');
  addr.sin_addr.s_addr := PInAddr(hostent^.h_addr_list^)^.s_addr;

  delay := clock;

  repeat
    // Hier bleiben wir so lange in der Schleife, bis wir online sind 
    // oder das Systems neu gestartet bzw. herunter gefahren wird ;)
    error := connect(hSocket, addr, SizeOf(TSockAddrIn));
  until (error <> SOCKET_ERROR);

  error := recv(hSocket, time, 4, 0);
  if error = SOCKET_ERROR then
  begin
    SysLog(LOG_ERR, PChar('ntpupdate: ' + strerror(errno)));
    shutdown(hSocket, 0);
    Exit;
  end;

  delay := clock - delay;

  shutdown(hSocket, 0);

  time := htonl(time);

  dt := time / 86400;
  dt := IncMilliSecond(dt, delay);
  dt := IncDay(dt, 2);

  gettimeofday(tv, nil);
  ut := localtime(@tv.tv_sec)^;
  dt := IncSecond(dt, ut.__tm_gmtoff + ut.tm_isdst * 3600);

  ut.tm_mday := DayOf(dt);
  ut.tm_mon := MonthOf(dt) - 1;
  ut.tm_year := YearOf(dt) - 1900;
  ut.tm_hour := HourOf(dt);
  ut.tm_min := MinuteOf(dt);
  ut.tm_sec := SecondOf(dt);

  tv.tv_sec := mktime(ut);
  FillChar(tz, SizeOf(tz), #0);

  settimeofday(tv, tz);
  SysLog(LOG_INFO, 'ntpupdate: Date & time synchronized');
  CloseLog;
end;

begin
  with TNtpUpdate.Create do
    try
      Run;
    finally
      Free;
    end;
end.