Certbot wrapper for FreePascal

certbot.pas

unit certbot;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, eventlog, process
  ;

type

  { TCertBot }

  TCertBot = class
  private
    FCilently: Boolean;
    FDomainName: String;
    FDryRun: Boolean;
    FLogDebug: Boolean;
    FLogger: TEventLog;
    FSudo: Boolean;
    FWithWWW: Boolean;
    function ExecSend(aProcess: TProcess): Boolean;
    function ExecReceive(aProcess: TProcess): Boolean;
    procedure HookAfterCertBot;                       
    procedure LinuxChown(const aFolder: String);
  protected
    procedure Log(aLogEvent: TEventType; const aMsg: String);
  public
    function AddDomainName(aDomainName: String; aWithWWW: Boolean = True): Boolean;
    function Execute: Boolean;
    property Cilently: Boolean read FCilently write FCilently;
    property DomainName: String read FDomainName write FDomainName;
    property DryRun: Boolean read FDryRun write FDryRun;
    property LogDebug: Boolean read FLogDebug write FLogDebug;
    property Logger: TEventLog read FLogger write FLogger;
    property Sudo: Boolean read FSudo write FSudo;
    property WithWWW: Boolean read FWithWWW write FWithWWW;
  end;

implementation

const
  _CrtBt='certbot';

{ TCertBot }

procedure TCertBot.LinuxChown(const aFolder: String);
const
  User = 'www-data';
var
  aProcess: TProcess;
begin
  aProcess := TProcess.Create(nil);
  with aProcess do
    try
      Executable:='chown';
      Parameters.Add('-R');
      Parameters.Add(User+':'+User);
      Parameters.Add('/etc/letsencrypt/'+aFolder+'/'+DomainName);
      Options:=[poUsePipes, poStderrToOutPut, poNoConsole];
      try
        Execute;
      except
        on E: Exception do Log(etError, 'Hook. '+E.Classname+': '+E.message+'. ExitCode: '+ExitCode.ToString);
      end;
    finally
      Free;
    end;
end;

procedure TCertBot.HookAfterCertBot;
begin
  Log(etInfo, 'Try hook after append certificate folders. Domain: '+FDomainName);
  LinuxChown('archive');
  LinuxChown('live');
end;

function TCertBot.ExecSend(aProcess: TProcess): Boolean;
begin
  Result:=False;
  with aProcess do
  begin
    if FSudo then
      Executable := 'sudo '+_CrtBt
    else
      Executable := _CrtBt;
    Executable := _CrtBt;
    Parameters.Add('certonly');
    if FDryRun then
      Parameters.Add('--dry-run');
    if FCilently then
    begin
      Parameters.Add('--non-interactive');
      Parameters.Add('--agree-tos');
    end;
    Parameters.Add('-d');  // Domain
    Parameters.Add(FDomainName);
    if FWithWWW then
    begin
      Parameters.Add('-d');
      Parameters.Add('www.'+FDomainName);
    end;
    try
      Options:=[poUsePipes, poStderrToOutPut, poNoConsole];
      Execute;
      Result:=True;
    except
      on E: Exception do Log(etError, 'ExecSend. '+E.Classname+': '+E.message+'. ExitCode: '+ExitCode.ToString);
    end;
  end;
end;

function TCertBot.ExecReceive(aProcess: TProcess): Boolean;
const
  BUF_SIZE = 2048; // Buffer size for reading the output in chunks
var
  aOutputStream: TMemoryStream;
  aBuffer       : array[1..BUF_SIZE] of byte;
  aBytesRead: LongInt;
  aOutput, s: String;
  aStringStream: TStringStream;
  aFlags: Integer;
begin
  Result:=False;
  with aProcess do
  begin
    aOutputStream := TMemoryStream.Create;
    try
      repeat
        aBytesRead := aProcess.Output.Read(aBuffer{%H-}, BUF_SIZE);
        aOutputStream.Write(aBuffer, aBytesRead)
      until aBytesRead = 0;
      aStringStream:=TStringStream.Create(EmptyStr);
      try
        aOutputStream.SaveToStream(aStringStream);
        s:=aStringStream.DataString;
        Result:=s.Contains('Successfully received certificate');
        if not Result then
          if s.Contains('Certificate not yet due for renewal; no action taken') then
          begin
            Result:=True;
            Logger.Warning('Certificate already added. No action taken');
          end;
        if not Result then
          aStringStream.SaveToFile('~certbot_lasterror.log');
      finally
        aStringStream.Free;
      end;
      aOutput:='~certbot.log';
      aFlags:= fmOpenReadWrite or fmShareDenyNone;
      if not FileExists(aOutput) then
        aFlags:= aFlags or fmCreate;
      with TFileStream.Create(aOutput, aFlags) do
      begin
        Seek(0, soFromEnd);
        s:=LineEnding+'============ '+DateTimeToStr(Now)+LineEnding+'Domain: '+DomainName+LineEnding+'============';
        Write(s[1], Length(s));
        aOutputStream.Position := 0;
        CopyFrom(aOutputStream, aOutputStream.Size);
        Free
      end;
      Result:=Result and (aProcess.ExitCode=0);
    finally                     
      aOutputStream.Free;
    end;
  end;
end;

procedure TCertBot.Log(aLogEvent: TEventType; const aMsg: String);
begin
  if Assigned(FLogger) then
    FLogger.Log(aLogEvent, aMsg);
end;

function TCertBot.AddDomainName(aDomainName: String; aWithWWW: Boolean): Boolean;
begin
  FDomainName:=aDomainName;
  FWithWWW:=aWithWWW;
  Result:=Execute;
end;

function TCertBot.Execute: Boolean;
var
  aProcess: TProcess;
begin
  Result:=False;
  aProcess := TProcess.Create(nil);
  with aProcess do
    try
      if ExecSend(aProcess) then
        Result:=ExecReceive(aProcess);
      if Result then
      begin
        HookAfterCertBot;
        Log(etInfo, 'The certificate for domain '+FDomainName+' has been succesfully added')
      end
      else
        Log(etError, 'An error occured while trying to receive the certificate for domain '+FDomainName);
    finally
      Free;
    end;
end;

end.