From: beware <beware@bircd.org>
Date: Wed, 10 Nov 2021 01:20:18 +0000 (+0000)
Subject: own implementation of parsing the timezone file because freepascals implementation... 
X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/0c9341fb9508e6dc82fb3dd32324b26c74afe3fd

own implementation of parsing the timezone file because freepascals implementation does not support 64 bits timestamps

git-svn-id: file:///svnroot/lcore/trunk@164 b1de8a11-f9be-4011-bde0-cc7ace90066a
---

diff --git a/btime.pas b/btime.pas
index 8826a4d..ae6ffa5 100644
--- a/btime.pas
+++ b/btime.pas
@@ -64,6 +64,12 @@ function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z
 procedure beginhightimerrate;
 procedure endhightimerrate;
 
+procedure tzinvalidate;
+
+{$ifdef unix}
+function tzgetoffsetforts(ts:tunixtimeint):integer;
+{$endif}
+
 {$ifdef mswindows}
 function unixtimefloat_systemtime:float;
 {$endif}
@@ -262,10 +268,15 @@ end;
 
 {------------------------------ end of *nix/freepascal section}
 
-{$else} {delphi 3}
+{$else} {windows}
 {------------------------------ windows/delphi code to read time}
 
 
+procedure tzinvalidate;
+begin
+  gettimezone;
+end;
+
 {simulate gettimeofday on windows so one can always use gettimeofday if preferred}
 
 procedure gettimeofday(var tv:ttimeval);
@@ -665,6 +676,226 @@ begin
 end;
 
 
+{$ifdef unix}
+
+var
+  tzerror:boolean;
+  tzfile:ansistring;
+
+function tzgetfilename:ansistring;
+var
+  t:textfile;
+
+  s,tz,tzdir:ansistring;
+begin
+  result := '';
+  filemode := 0;
+  {$ifdef unix}
+  tz := getenv('TZ');
+
+  if (copy(tz,1,1) = ':') then begin
+    tz := copy(tz,2,99999);
+
+    if (copy(tz,1,1) <> '/') then begin
+      tzdir := getenv('TZDIR');
+      if (tzdir = '') then begin
+        tzdir := '/usr/share/zoneinfo/';
+      end else begin
+        if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';
+      end;
+      tz := tzdir + tz;
+    end;
+
+    assignfile(t,tz);
+    {$i-}reset(t);{$i+}
+    if (ioresult = 0) then begin
+      closefile(t);
+      result := tz;
+      exit;
+    end;
+
+  end;
+  {$endif}
+  
+  assignfile(t,'/etc/localtime');
+  {$i-}reset(t);{$i+}
+  if (ioresult = 0) then begin
+    closefile(t);
+    result := '/etc/localtime';
+    exit;
+  end;
+
+  assignfile(t,'/etc/timezone');
+
+  s := '';
+  {$i-}reset(t);{$i+}
+  if (ioresult = 0) then begin
+    readln(t,s);
+    closefile(t);
+    if (s <> '') then begin
+      result := '/usr/share/zoneinfo/'+s;
+      exit;
+    end;
+  end;
+end;
+
+type
+  dvar=array[0..65535] of byte;
+  pdvar=^dvar;
+
+var
+  tzcache:pdvar;
+  tzsize:integer;
+
+procedure tzinvalidate;
+begin
+  if assigned(tzcache) then freemem(tzcache);
+  tzcache := nil;
+  tzsize := 0;
+  tzfile := '';
+  gettimezone;
+end;
+
+
+function tzgetoffsetforts(ts:tunixtimeint):integer;
+var
+  f:file;
+  buf:pdvar;
+  fs:integer;
+  ofs,ofs2:integer;
+  mode64:boolean;
+  has64:boolean;
+  a,index:integer;
+  //tzstrofs:integer;
+  t:int64;
+  tzh_ttisgmtcnt:integer;
+  tzh_ttisstdcnt:integer;
+  tzh_leapcnt:integer;
+  tzh_timecnt:integer;
+  tzh_typecnt:integer;
+  tzh_charcnt:integer;
+
+
+function getint:integer;
+begin
+  if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');
+  result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];
+  inc(ofs,4);
+end;
+
+function getint64:int64;
+begin
+  if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');
+  result := int64(getint) shl 32;
+  inc(result,cardinal(getint));
+end;
+
+
+function getbyte:byte;
+begin
+  if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');
+  result := buf[ofs];
+  inc(ofs);
+end;
+
+begin
+  result := 0;
+  tzerror := true;
+
+  if not assigned(tzcache) then begin
+
+    if (tzfile = '') then tzfile := tzgetfilename;
+
+    if (tzfile = '') then exit;
+
+    assignfile(f,tzfile);
+    filemode := 0;
+    {$i-}reset(f,1);{$i+}
+    if (ioresult <> 0) then begin
+      exit;
+    end;
+    tzsize := filesize(f);
+    if (tzsize > 65536) then tzsize := 65536;
+    getmem(tzcache,tzsize);
+    blockread(f,tzcache^,tzsize);
+    closefile(f);
+  end;
+  fs := tzsize;
+  buf := tzcache;
+  ofs := 0;
+  mode64 := false;
+
+ try
+   repeat
+     if (getint <> $545a6966) then exit; // 'TZif'
+     has64 := getbyte >= $32; //  '2'
+
+     inc(ofs,15);
+
+     tzh_ttisgmtcnt := getint;
+     tzh_ttisstdcnt := getint;
+     tzh_leapcnt := getint;
+     tzh_timecnt := getint;
+     tzh_typecnt := getint;
+     tzh_charcnt := getint;
+
+     if mode64 or (not has64) then break;
+     inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);
+     mode64 := true;
+   until false;
+   index := 0;
+
+   if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');
+   ofs2 := ofs;
+
+   for a := 0 to tzh_timecnt -1 do begin
+     if mode64 then t := getint64 else t := getint;
+     if (t > ts) then begin
+       index := a - 1;
+       break;
+     end;
+     if (a = tzh_timecnt -1) and (ts >= t) then index := a;
+   end;
+   ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;
+
+   if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');
+   index := buf[ofs+index];
+   inc(ofs,tzh_timecnt);
+
+   if (index >= tzh_typecnt) then raise exception.create('type');
+   ofs2 := ofs;
+  // writeln('ofs2 ',inttohex(ofs2,8));
+   inc(ofs,6 * index);
+   result := getint;
+
+   //tzisdst := getbyte;
+
+  //the abbreviation string
+  { tzstrofs := getbyte;
+   tzstr := '';
+   ofs := ofs2 + 6 * tzh_typecnt;
+   inc(ofs, tzstrofs);
+
+   repeat
+     a := getbyte;
+     if (a <> 0) then tzstr := tzstr + chr(a);
+   until (a = 0); }
+
+   tzerror := false;
+ except
+
+ end;
+end;
+
+function tzgetoffset:integer;
+begin
+  tzgetoffsetforts(unixtimeint);
+end;
+
+
+{$endif}
+
+
 procedure gettimezone;
 var
   {$ifdef UNIX}
@@ -681,7 +912,8 @@ var
 begin
   {$ifdef UNIX}
     {$ifdef above194}
-      timezone := tzseconds;
+      timezone := tzgetoffset;
+      //freepascal tzseconds is not 2038 safe
     {$else}
       gettime(hh,mm,ss);
       timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
@@ -690,8 +922,8 @@ begin
   timezone := round((now-now_utc)*86400);
   {$endif}
 
-  while timezone > 43200 do dec(timezone,86400);
-  while timezone < -43200 do inc(timezone,86400);
+  while timezone > 50400 do dec(timezone,86400);
+  while timezone < -50400 do inc(timezone,86400);
 
   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
   l := abs(timezone) div 60;