fpc/rtl/unix/timezone.inc
2023-07-14 20:13:43 +02:00

581 lines
14 KiB
PHP

{
Support for timezone info in /usr/share/timezone
}
type
ttzhead=packed record
tzh_identifier : array[0..3] of AnsiChar;
tzh_version : AnsiChar;
tzh_reserved : array[0..14] of byte;
tzh_ttisgmtcnt,
tzh_ttisstdcnt,
tzh_leapcnt,
tzh_timecnt,
tzh_typecnt,
tzh_charcnt : longint;
end;
pttinfo=^tttinfo;
tttinfo=packed record
offset : longint;
isdst : boolean;
idx : byte;
isstd : byte;
isgmt : byte;
end;
pleap=^tleap;
tleap=record
transition : int64;
change : longint;
end;
var
num_transitions,
num_leaps,
num_types : longint;
transitions : PInt64 = nil;
type_idxs : pbyte = Nil;
types : pttinfo = Nil;
zone_names : PAnsiChar = Nil;
leaps : pleap = Nil;
function find_transition(timer:int64;timerIsUTC:Boolean;var trans_start,trans_end:int64):pttinfo;
var
i,L,R,CompareRes : longint;
found : boolean;
function DoCompare: longint;
var
timerUTC: int64;
begin
if not timerIsUTC then
timerUTC:=timer-types[type_idxs[i-1]].offset
else
timerUTC:=timer;
if timerUTC<transitions[i-1] then
Exit(-1)
else
if timerUTC>=transitions[i] then
Exit(1)
else
Exit(0);
end;
var
timerLoUTC, timerHiUTC: int64;
begin
if (num_transitions>0) and not timerIsUTC then
begin
timerLoUTC:=timer-types[type_idxs[0]].offset;
timerHiUTC:=timer-types[type_idxs[num_transitions-1]].offset;
end
else
begin
timerLoUTC:=timer;
timerHiUTC:=timer;
end;
if (num_transitions=0) or (timerLoUTC<transitions[0]) then
{ timer is before the first transition }
begin
i:=0;
while (i<num_types) and (types[i].isdst) do
inc(i);
if (i=num_types) then
i:=0;
{ unknown transition boundaries }
trans_start:=low(trans_start);
trans_end:=high(trans_end);
end
else
if (num_transitions>0) and (timerHiUTC>=transitions[num_transitions-1]) then
{ timer is after the last transition }
begin
i:=type_idxs[num_transitions-1];
trans_start:=transitions[num_transitions-1];
trans_end:=high(trans_end);
end
else
{ timer inbetween }
begin
// Use binary search.
L := 1;
R := num_transitions-1;
found := false;
while not found and (L<=R) do
begin
I := L + (R - L) div 2;
CompareRes := DoCompare;
if (CompareRes>0) then
L := I+1
else begin
R := I-1;
if (CompareRes=0) then
found:=true; // break cycle
end;
end;
if not found then
Exit(nil);
trans_start:=transitions[i-1];
trans_end:=transitions[i];
i:=type_idxs[i-1];
end;
find_transition:=@types[i];
end;
procedure DoGetLocalTimezone(info:pttinfo;const trans_start,trans_end:int64;var ATZInfo:TTZInfo);
begin
ATZInfo.validsince:=trans_start;
ATZInfo.validuntil:=trans_end;
ATZInfo.Daylight:=info^.isdst;
ATZInfo.Seconds:=info^.offset;
end;
procedure DoGetLocalTimezoneEx(timer:int64;info:pttinfo;var ATZInfoEx:TTZInfoEx);
var
i : longint;
names: array[Boolean] of PAnsiChar;
begin
names[true]:=nil;
names[false]:=nil;
ATZInfoEx.leap_hit:=0;
ATZInfoEx.leap_correct:=0;
i:=0;
while (i<num_types) do
begin
names[types[i].isdst]:=@zone_names[types[i].idx];
inc(i);
end;
names[info^.isdst]:=@zone_names[info^.idx];
ATZInfoEx.name[true]:=names[true];
ATZInfoEx.name[false]:=names[false];
i:=num_leaps;
repeat
if i=0 then
exit;
dec(i);
until (timer>leaps[i].transition);
ATZInfoEx.leap_correct:=leaps[i].change;
if (timer=leaps[i].transition) and
(((i=0) and (leaps[i].change>0)) or
(leaps[i].change>leaps[i-1].change)) then
begin
ATZInfoEx.leap_hit:=1;
while (i>0) and
(leaps[i].transition=leaps[i-1].transition+1) and
(leaps[i].change=leaps[i-1].change+1) do
begin
inc(ATZInfoEx.leap_hit);
dec(i);
end;
end;
end;
function GetLocalTimezone(timer:int64;timerIsUTC:Boolean;var ATZInfo:TTZInfo):Boolean;
var
info: pttinfo;
trans_start,trans_end,timerUTC: int64;
begin
{ check if time is in current global Tzinfo }
ATZInfo:=CurrentTZinfo[InterlockedExchangeAdd(CurrentTZindex, 0)];
if not timerIsUTC then
timerUTC:=timer-ATZInfo.seconds
else
timerUTC:=timer;
if (ATZInfo.validsince<=timerUTC) and (timerUTC<ATZInfo.validuntil) then
Exit(True);
LockTZInfo;
info:=find_transition(timer,timerIsUTC,trans_start,trans_end);
GetLocalTimezone:=assigned(info);
if GetLocalTimezone then
DoGetLocalTimezone(info,trans_start,trans_end,ATZInfo);
UnlockTZInfo;
end;
function GetLocalTimezone(timer:int64;timerIsUTC:Boolean;var ATZInfo:TTZInfo;var ATZInfoEx:TTZInfoEx):Boolean;
var
info: pttinfo;
trans_start,trans_end,timerUTC: int64;
begin
{ check if time is in current global Tzinfo }
ATZInfo:=CurrentTZinfo[InterlockedExchangeAdd(CurrentTZindex, 0)];
if not timerIsUTC then
timerUTC:=timer-ATZInfo.seconds
else
timerUTC:=timer;
if (ATZInfo.validsince<=timerUTC) and (timerUTC<ATZInfo.validuntil) then
begin
ATZInfoEx:=TZInfoEx;
Exit(True);
end;
{ not current - search through all }
LockTZInfo;
info:=find_transition(timer,timerIsUTC,trans_start,trans_end);
GetLocalTimezone:=assigned(info);
if GetLocalTimezone then
begin
DoGetLocalTimezone(info,trans_start,trans_end,ATZInfo);
DoGetLocalTimezoneEx(timer,info,ATZInfoEx);
end;
UnlockTZInfo;
end;
procedure RefreshTZInfo;
var
NewTZInfo: TTZInfo;
NewTZInfoEx: TTZInfoEx;
begin
LockTZInfo;
if GetLocalTimezone(fptime,true,NewTZInfo,NewTZInfoEx) then
SetTZInfo(NewTZInfo,NewTZInfoEx);
UnlockTZInfo;
end;
Const
DefaultTimeZoneDir = '/usr/share/zoneinfo';
function TimeZoneDir : ShortString;
begin
// Observe TZDIR environment variable.
TimeZoneDir:=fpgetenv('TZDIR');
if TimeZoneDir='' then
TimeZoneDir:=DefaultTimeZoneDir;
if TimeZoneDir[length(TimeZoneDir)]<>'/' then
TimeZoneDir:=TimeZoneDir+'/';
end;
function ReadTimezoneFile(fn:string) : Boolean;
function decode(const l:longint):longint;
begin
{$IFDEF ENDIAN_LITTLE}
decode:=SwapEndian(l);
{$ELSE}
decode:=l;
{$ENDIF}
end;
function decode(const l:int64):int64;
begin
{$IFDEF ENDIAN_LITTLE}
decode:=SwapEndian(l);
{$ELSE}
decode:=l;
{$ENDIF}
end;
const
bufsize = 2048;
var
buf : array[0..bufsize-1] of byte;
bufptr : pbyte;
bufbytes : tsSize;
bufoverflow : boolean;
f : longint;
tzhead : ttzhead;
function readfilebuf : TsSize;
begin
bufptr := @buf[0];
bufbytes:=fpread(f, buf, bufsize);
readfilebuf:=bufbytes;
end;
Procedure checkbufptr(asize : integer);
var
a : tssize;
begin
a:=bufptr-@buf+asize;
if (a>bufbytes) then
bufoverflow:=true;
end;
function readbufbyte: byte;
begin
if bufptr > @buf[bufsize-1] then
readfilebuf;
checkbufptr(1);
readbufbyte := bufptr^;
inc(bufptr);
end;
function readbuf(dest:pointer; count: integer): integer;
var
numbytes: integer;
begin
readbuf := 0;
repeat
numbytes := (@buf[bufsize-1] + 1) - bufptr;
if numbytes > count then
numbytes := count;
if numbytes > 0 then
begin
checkbufptr(numbytes);
if assigned(dest) then
move(bufptr^, dest^, numbytes);
inc(bufptr, numbytes);
dec(count, numbytes);
inc(readbuf, numbytes);
inc(dest, numbytes);
end;
if count > 0 then
readfilebuf
else
break;
until false;
end;
function readheader: boolean;
var
i : longint;
begin
i:=readbuf(@tzhead,sizeof(tzhead));
if i<>sizeof(tzhead) then
exit(False);
tzhead.tzh_timecnt:=decode(tzhead.tzh_timecnt);
tzhead.tzh_typecnt:=decode(tzhead.tzh_typecnt);
tzhead.tzh_charcnt:=decode(tzhead.tzh_charcnt);
tzhead.tzh_leapcnt:=decode(tzhead.tzh_leapcnt);
tzhead.tzh_ttisstdcnt:=decode(tzhead.tzh_ttisstdcnt);
tzhead.tzh_ttisgmtcnt:=decode(tzhead.tzh_ttisgmtcnt);
readheader:=(tzhead.tzh_identifier[0]='T') and (tzhead.tzh_identifier[1]='Z')
and (tzhead.tzh_identifier[2]='i') and (tzhead.tzh_identifier[3]='f');
end;
procedure AllocFields;
begin
num_transitions:=tzhead.tzh_timecnt;
num_types:=tzhead.tzh_typecnt;
num_leaps:=tzhead.tzh_leapcnt;
reallocmem(transitions,num_transitions*sizeof(int64));
reallocmem(type_idxs,num_transitions);
reallocmem(types,num_types*sizeof(tttinfo));
reallocmem(zone_names,tzhead.tzh_charcnt);
reallocmem(leaps,num_leaps*sizeof(tleap));
end;
function readdata: boolean;
var
i : longint;
longval: longint;
version: longint;
begin
if tzhead.tzh_version='2' then
begin
version:=2;
// skip version 0
readbuf(nil,
tzhead.tzh_timecnt*4 // transitions
+tzhead.tzh_timecnt // type_idxs
+tzhead.tzh_typecnt*6 // types
+tzhead.tzh_charcnt // zone_names
+tzhead.tzh_leapcnt*8 // leaps
+tzhead.tzh_ttisstdcnt // isstd
+tzhead.tzh_ttisgmtcnt // isgmt
);
readheader; // read version 2 header
if tzhead.tzh_version<>'2' then
Exit(False);
end
else
version:=0;
AllocFields;
if version=2 then
begin // read 64bit values
readbuf(transitions,num_transitions*sizeof(int64));
for i:=0 to num_transitions-1 do
transitions[i]:=decode(transitions[i]);
end
else
begin // read 32bit values
for i:=0 to num_transitions-1 do
begin
readbuf(@longval,sizeof(longval));
transitions[i]:=decode(longval);
end;
end;
readbuf(type_idxs,num_transitions);
for i:=0 to num_types-1 do
begin
readbuf(@types[i].offset,sizeof(LongInt));
types[i].offset:=decode(types[i].offset);
readbuf(@types[i].isdst,1);
readbuf(@types[i].idx,1);
types[i].isstd:=0;
types[i].isgmt:=0;
end;
readbuf(zone_names,tzhead.tzh_charcnt);
if version=2 then
begin // read 64bit values
for i:=0 to num_leaps-1 do
begin
readbuf(@leaps[i].transition,sizeof(int64));
readbuf(@leaps[i].change,sizeof(longint));
leaps[i].transition:=decode(leaps[i].transition);
leaps[i].change:=decode(leaps[i].change);
end;
end
else
begin
for i:=0 to num_leaps-1 do
begin
readbuf(@longval,sizeof(longval));
leaps[i].transition:=decode(longval);
readbuf(@longval,sizeof(longval));
leaps[i].change:=decode(longval);
end;
end;
for i:=0 to tzhead.tzh_ttisstdcnt-1 do
types[i].isstd:=byte(readbufbyte<>0);
for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
types[i].isgmt:=byte(readbufbyte<>0);
readdata:=true;
end;
procedure ClearCurrentTZinfo;
var
i:integer;
begin
for i:=low(CurrentTZinfo) to high(CurrentTZinfo) do
CurrentTZinfo[i] := Default(TTZInfo);
end;
begin
if fn='' then
fn:='localtime';
if fn[1]<>'/' then
fn:='/usr/share/zoneinfo/'+fn;
f:=fpopen(fn,Open_RdOnly);
if f<0 then
exit(False);
bufoverflow:=false;
bufptr := @buf[bufsize-1]+1;
tzhead:=default(ttzhead);
LockTZInfo;
ReadTimezoneFile:=(readheader() and readdata()) and not BufOverflow;
ClearCurrentTZinfo;
UnlockTZInfo;
fpclose(f);
end;
Const
// Debian system; contains location of timezone file.
TimeZoneLocationFile = '/etc/timezone';
// SuSE has link in /usr/lib/zoneinfo/localtime to /etc/localtime
// RedHat uses /etc/localtime
TimeZoneFile = '/etc/localtime'; // POSIX
AltTimeZoneFile = '/usr/lib/zoneinfo/localtime'; // Other
iOSTimeZoneFile = '/var/db/timezone/localtime'; // iOS
{$ifdef BSD}
BSDTimeZonefile = DefaultTimeZoneDir; // BSD usually is POSIX
// compliant though
{$ENDIF}
{$ifndef FPC_HAS_GETTIMEZONEFILE}
function GetTimezoneFile:string;
var
f,len : longint;
fn,s : shortstring;
info : stat;
begin
GetTimezoneFile:='';
// Observe TZ variable.
fn:=fpgetenv('TZ');
if (fn<>'') then
if (fn[1]=':') then
begin
Delete(fn,1,1);
if (fn<>'') then
begin
if (fn[1]<>'/') then
Exit(TimeZoneDir+fn);
Exit(fn);
end;
end;
if (fn='') then
fn:=TimeZoneLocationFile;
f:=fpopen(TimeZoneLocationFile,Open_RdOnly);
if f>0 then
begin
len:=fpread(f,s[1],high(s));
s[0]:=chr(len);
len:=pos(#10,s);
if len<>0 then
s[0]:=chr(len-1);
fpclose(f);
GetTimezoneFile:=s;
end
// Try SuSE
else if fpstat(TimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
GetTimeZoneFile:=TimeZoneFile
// Try RedHat
else If fpstat(AltTimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
GetTimeZoneFile:=AltTimeZoneFile
{$ifdef BSD}
// else
// If fpstat(BSDTimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
// GetTimeZoneFile:=BSDTimeZoneFile
{$ENDIF}
{$if (defined(darwin) and defined(arm)) or defined(iphonesim)}
else If fpstat(iOSTimeZoneFile,info)>=0 then
GetTimeZoneFile:=iOSTimeZoneFile
{$endif}
end;
{$endif ndef FPC_HAS_GETTIMEZONEFILE}
procedure InitLocalTime;
begin
ReadTimezoneFile(GetTimezoneFile);
RefreshTZInfo;
end;
procedure DoneLocalTime;
begin
if assigned(transitions) then
freemem(transitions);
transitions:=nil;
if assigned(type_idxs) then
freemem(type_idxs);
type_idxs:=nil;
if assigned(types) then
freemem(types);
types:=nil;
if assigned(zone_names) then
freemem(zone_names);
zone_names:=Nil;
if assigned(leaps) then
freemem(leaps);
leaps:=nil;
num_transitions:=0;
num_leaps:=0;
num_types:=0;
end;
Procedure ReReadLocalTime;
begin
LockTZInfo;
DoneLocalTime;
InitLocalTime;
UnlockTZInfo;
end;