// Reconcile DEP-5 debian/copyright to licensecheck
//
// Copyright : 2023-2024 P Blackman
// License   : BSD-2-clause
//
// Parsing of DEP-5 copyright file

unit dep5;
{$mode delphi}

interface


function CopyRightFile : Boolean;


implementation uses StrUtils, SysUtils, Process, Classes, gpl, options, rstrings, support, filedata;

type // DEP-5 Field types
    ftype = (fNull, fEOF, fBlank, fFormat, fFiles, fUName, fUContact,
            fSource, fDisclaimer, fComment, fLicense, fCopyRight, fContinue);
var
    cfile : Text;
    crline : String;
    LastField : ftype;
    DebianFilesPara : Boolean;
    LineNumber : Integer;

function Test (S : String) : Boolean;
begin
    if Length (crline) < Length (S) then
        result := false
    else
        result := s = ExtractWord (1, crline, WhiteSpace);
end;

// Process one line from d/copyright
function CheckLine : ftype;
begin
    if Test ('Files:') then
        result := fFiles
    else
    if Test ('License:') then
        result := fLicense
    else
    if Test ('Copyright:') then
        result := fCopyright
    else
    if Test ('copyright:') then
        result := fCopyright
    else
    if Test ('Comment:') then
        result := fComment
    else
    if Test ('Upstream-Name:') then
        result := fUName
    else
    if Test ('Upstream-Contact:') then
        result := fUContact
    else
    if Test ('Source:') then
        result := fSource
    else
    if Test ('Disclaimer:') then
        result := fDisclaimer
    else
    iF EOF (cfile ) then
        result := fEOF
    else
    if IsEmptyStr (crline, WhiteSpace) then
        result := fBlank
    else
    if crline[1] in WhiteSpace then
        result := fContinue
    else
        if (crline = 'Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/')
        or (crline = 'Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/') then
            result := fFormat
    else
        result := fNull;

    if not (result in [fBlank, fContinue, fNull, fEOF]) then
        LastField := result;
end;


procedure UpdateLicenses (const FilesList : tStringList; PathDepth, GlobCount : Integer); forward;

procedure PatternSearch (FileStr : AnsiString);
var PathDepth,
    GlobCount   : Integer;
    OK          : Boolean;
    S1          : AnsiString;
    PFilesList  : tStringList;
begin
    PathDepth := FileStr.CountChar ('/');
    GlobCount := FileStr.CountChar ('*');

    if FileStr = '*' then
        FileStr := '.'; // Using * here misses top level hidden folders

    if FileStr.CountChar ('*') = 1 then // Single Asterisk
    begin
        GlobSearch (FileStr, S1);
        OK := True;
    end
    else
        OK := RunCommand('/usr/libexec/lrc-find', [FileStr], S1,  [poUsePipes, poWaitOnExit]);

    If OK then
    begin
        PFilesList := tStringList.Create;
        MangleName (S1);
        PFilesList.text := S1;
        UpdateLicenses (PFilesList, PathDepth, GlobCount);
        PFilesList.Free;
     end
     else
        writeln ('Pattern Search failed ',FileStr);
end;

procedure UpdateLicenses (const FilesList : tStringList; PathDepth, GlobCount : Integer);
var F,W,P,Len   : Integer;
    FileStr,
    FileNam     : AnsiString;
    LicenseStr  : String;
    GlobOrderProblem : Boolean;
begin
    GlobOrderProblem := False;
    Len := 1 + Length ('License:');
    LicenseStr := TrimRight (AdjustGPL (TrimLeft (ExtractSubstr (crline, Len, []))));

    For FileStr in FilesList do
    begin
        for W := 1 to WordCount (FileStr, WhiteSpace+[',']) do
        begin
            FileNam := ExtractWord (W, FileStr, WhiteSpace+[',']);

            if LeftStr (FileNam, 2) = './' then
            begin
                // Strip leading ./
                P := 3;
                FileNam := ExtractSubstr (FileNam, P, []);
            end;

            if (Pos ('*', FileNam) <> 0) or (Pos ('?', FileNam) <> 0) then
                PatternSearch (FileNam)
            else
            begin
                F := FindThisFile (FileNam);
                if F >= 0 then
                begin
                    if PathDepth = -1 then // not via a pattern search
                        PathDepth := FileNam.CountChar ('/');
                    iF not SetDep5License (F, PathDepth, GlobCount, LicenseStr) then
                        GlobOrderProblem := True;
                end;
            end;
        end;
   end;

    If GlobOrderProblem then
        Writeln ('  ' + rsGPO + ' ', LineNumber);
end;

Procedure ReadLine;
begin
    Readln (cfile, crline);
    inc (LineNumber);
end;

// Note a group of files, and their associated license
Procedure CheckFilesPara;
var Posn : Integer;
    Done : Boolean;
    FilesStr : AnsiString;
    FilesList : tStringList;
begin
    FilesList := tStringList.Create;

    posn     := 1+Length ('Files:');
    FilesStr := ExtractSubstr (crline, Posn, []);
    FilesStr := TrimLeftSet (FilesStr, WhiteSpace);

    FilesList.Add (FilesStr);

    if NOT DebianFilesPara then
        DebianFilesPara := StartsStr( 'debian/', FilesStr);

    Done := false;
    while not Done do
    begin
        Readline;

        if CheckLine in [fBlank, fEOF] then
            Done := true
        else
        if (lastField = fCopyRight) or (lastField = fComment) then
            // skip, only tracking licenses
        else
        if CheckLine = fContinue then
        begin
            Removeleadingchars (crline, WhiteSpace);
            FilesList.Add (crline);

            if NOT DebianFilesPara then
                DebianFilesPara := StartsStr( 'debian/', crline);
        end
        else
        if CheckLine = fLicense then
        begin
            UpdateLicenses (FilesList, -1, 0); // Indicate PathDepth not (yet) set via a globbing pattern
            Done := true;
        end;
    end;

    FilesList.Free;

    repeat Readline;
    until CheckLine in [fBlank, fEOF];
end;

function CheckHeader : Boolean;
begin
    Readline;

    if CheckLine <> fFormat then
        result := false
    else
    begin
        result := true;
        repeat Readline;
        until CheckLine in [fFiles, fBlank, fEOF];

        if lastField = fFiles then
            CheckFilesPara;
    end;
end;

Procedure LicensePara; // Skip, ignoring contents
begin
    repeat Readline;
    until CheckLine in [fBlank, fEOF];
end;

procedure CheckPara;
begin
    Readline;

    if CheckLine = fFiles then
        CheckFilesPara
    else
    if CheckLine = fLicense then
        LicensePara
end;

function CheckFile : Boolean;
begin
    DebianFilesPara := False;
    LineNumber      := 0;

    if not Option_Format then
        Writeln (rsRC + ' d/copyright  ....'); // Reading copyright
    If CheckHeader then
    begin
        result := true;
        While NOT EOF (cfile) do
            CheckPara;

        if NOT DebianFilesPara then
            Writeln ('  ' + rsMFP + ' debian/'); // Missing Files Paragraph for
    end
    else
    begin
        result := false;
        Writeln (rsID5 + ' debian/copyright'); // Invalid DEP-5 header in
    end
end;

function CopyRightFile : Boolean;
begin
    If OpenFile ('debian/copyright', cfile) then
    begin
        if not CheckFile then
        begin
            Writeln ('Failed to process debian/copyright');
            result := false;
        end
        else
            result := true;
        Close (cfile);
    end
    else
        result := false;
end;

end.