unit uAppUp;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, uAppVer, uAppLog, uPasExt, FPHTTPClient;

type
  TAppUpdateInfoType = record
    Status:integer;
    Application:string;
    Version:String;
    Size:LongInt;
    FileName:String;
    URL:record
        Download:string;
        Readme:String;
        History:String;
        License:String;
        Verify:String;
    end;
  end;

var
  UpdateServer : String;

function CheckForUpdate(var UpdateInfo : TAppUpdateInfoType) : boolean; overload;

implementation


procedure CheckForUpdateTask(var UpdateInfo: TAppUpdateInfoType);
const
  MetaTag = '<meta name="update-server" content="latest"';
var
  ResultText, Line, V : String;
  P, E : integer;
begin
  with UpdateInfo do begin
    Status:=-1;
    Application:='';
    Version:='';
    Size:=-1;
    FileName:='';
    URL.Download:='';
    URL.History:='';
    URL.Readme:='';
    URL.License:='';
    URL.Verify:='';
  end;
  with TFPHTTPClient.Create(nil) do
    try
      try
        ResultText := Get(UpdateServer + '/?app=' + APP_ORIGINALFILENAME );
        if (ResponseStatusCode <> 200) then begin
           UpdateInfo.Status:=ResponseStatusCode;
           raise Exception.Create(IntToStr(UpdateInfo.Status));
        end;
        if ResultText = '' then begin
           UpdateInfo.Status:=503;
           raise Exception.Create(IntToStr(UpdateInfo.Status));
        end;
        P := Pos(MetaTag, Lowercase(ResultText));
        if P > 0 then P := P + Length(MetaTag);
        E := Pos('/>', ResultText, P + 1);
        if (P < 1) or (E < 1) then begin
           UpdateInfo.Status:=404;
           raise Exception.Create(IntToStr(UpdateInfo.Status));
        end;
        ResultText := Copy(ResultText, P, E - P );
        {$ifopt D+}
        // Debug('Update server latest version: ' + CRLF + ResultText);
        {$endif}
        ResultText:=AdjustEOLn(ResultText);
        while ResultText <> '' do begin
          Line:=LTrim(PopLine(ResultText));
          if Line = '' then Continue;
          V := LowerCase(PopDelim(Line, '='));
          if HasLeading('data-', V) then
             V := ExcludeLeading('data-', V)
          else
              Continue;
          Line:=LTrim(RTrim(Copy(Line, 2, Length(Line) - 2)));
          {$ifopt D+}
          // Debug(V + ':' + Line);
          {$endif}
          case V of
          'application' : UpdateInfo.Application:=Line;
          'version'     : UpdateInfo.Version:=Line;
          'bytes'       : UpdateInfo.Size:=StrToInt(Line);
          'link'        : UpdateInfo.URL.Download:=Line;
          'readme'      : UpdateInfo.URL.Readme:=Line;
          'history'     : UpdateInfo.URL.History:=Line;
          'license'     : UpdateInfo.URL.License:=Line;
          'verify'      : UpdateInfo.URL.License:=Line;
          {$ifopt D+}
          // else
          //  Debug('attribute ' + V + ' not recognized.');
            {$endif}
          end;
        end;
        if (Uppercase(UpdateInfo.Application) <>
          UpperCase(APP_ORIGINALFILENAME)) or (
          UpdateInfo.URL.Download = '') or (
          UpdateInfo.Size < 0) then begin
             UpdateInfo.Status:=400;
             raise Exception.Create(IntToStr(UpdateInfo.Status));
        end;
        if (APP_VERSION <> UpdateInfo.Version) then begin
             // Assuming server knows the latest version
             UpdateInfo.Status:=0;
        end else begin
          // Exists with code 200, ok but running that version.
        end;
      except
        // Log('Version query failed.');
      end;

    finally
      Free;
    end;
end;

function CheckForUpdate( var UpdateInfo: TAppUpdateInfoType): boolean;
var
  S : String;
begin
  Log('Query ' + UpdateServer + ' for latest version of ' + APP_ORIGINALFILENAME );
  try
    CheckForUpdateTask(UpdateInfo);
  finally
  end;
  Log('Result from ' + UpdateServer + ' query #' + IntToStr( UpdateInfo.Status ) );
  case UpdateInfo.Status of
    0   : S := 'New version ' + UpdateInfo.Version + ' detected.';
    200 : S := 'Already running ' + UpdateInfo.Version + ' version.';
    400 : S := 'Invalid response from server (' + UpdateServer + ')' + '.';
    404 : S := 'Server (' + UpdateServer + ') does not contain updates for ' +
          APP_ORIGINALFILENAME + '.';
    503 : S := 'No response from server (' + UpdateServer + ').';
  else
        S := 'Unknown or general http client error.';
  end;
  Log('#' + IntToStr( UpdateInfo.Status ) + ', ' + S);
  Result := UpdateInfo.Status = 0;
end;


initialization
  UpdateServer:='http://up.lod.bz';
finalization
end.