// *****************************************************************************
// Copyright: © 2011 Patrick Kolla-ten Venne. All rights reserved.
// License:   LGPL or custom license agreement (Safer-Networking Ltd.)
// File:      snlAPIVirusTotal.pas
// Compiler:  Delphi, FreePascal
// Purpose:   Use the VirusTotal API to look up file sample (or url) information
// Authors:   Patrick Kolla-ten Venne (pk)
// *****************************************************************************
// Dependencies:
// uLkJSON 1.07 - JSON support library by Leonid Koninin,
// Indy 10 - http access
// Synapse - http access, needs libeay32.dll and ssleay32.dll
// *****************************************************************************
// Changelog (new entries first):
// ---------------------------------------
// 2011-04-05  3h   pk  Initial release
// 2011-04-05  ##   --  Beautified code (using Code Beautifier Wizard)
// 2011-04-05  ##   --  Added this header (from Code Beautifier Wizard)
// *****************************************************************************
// Comments:
// The Synapse implementation is not fully completed yet.
// *****************************************************************************

unit snlAPIVirusTotal;

{$DEFINE SaferNetworking}
{ .$DEFINE UseSynapse }
{$DEFINE UseIndy10}

interface

uses
   SysUtils,
   Classes,
   uLkJSON;

type
   VirusTotalException              = class(Exception);
   VirusTotalInvalidAPIKeyException = class(VirusTotalException);
   VirusTotalAPIKeyMissingException = class(VirusTotalException);
   VirusTotalAPIExceededException   = class(VirusTotalException);

   TVirusTotalAPI = class
   private
      FAPIKey: AnsiString;
      procedure TestAPIKey;
      function GetReport(const AURL, AHash: AnsiString): TlkJSONbase; overload;
      function GetReport(const AURL, AHash: AnsiString; AMeta, AList: TStrings): boolean; overload;
      function ScanFile(const AFilename: WideString): TlkJSONbase; overload;
      function ScanURL(const AURL: AnsiString): TlkJSONbase; overload;
   public
      function GetFileReport(const AHash: AnsiString; AMeta, AList: TStrings): boolean; overload;
      function GetUrlReport(const AURL: AnsiString; AMeta, AList: TStrings): boolean; overload;
      function ScanFile(const AFilename: WideString; var AScanID: AnsiString): boolean; overload;
      function ScanURL(const AURL: AnsiString; var AScanID: AnsiString): boolean; overload;
      property APIKey: AnsiString read FAPIKey write FAPIKey;
   end;

implementation

uses
   {$IFDEF SaferNetworking}
   snlDebug,
   snlCredits,
   snlProtoDownloadIndy,
   {$ENDIF SaferNetworking}
   {$IFDEF UseIndy10}
   IdHTTP,
   IdSSLOpenSSL,
   IdMultipartFormData,
   {$ENDIF UseIndy10}
   {$IFDEF UseSynapse}
   synacode,
   synautil,
   httpsend,
   ssl_openssl,
   {$ENDIF UseSynapse}
   Windows;

const
   SURLGetFileReport: AnsiString = 'https://www.virustotal.com/api/get_file_report.json';
   SURLGetUrlReport: AnsiString  = 'https://www.virustotal.com/api/get_url_report.json';
   SURLScanFile: AnsiString      = 'https://www.virustotal.com/api/scan_file.json';
   SURLScanURL: AnsiString       = 'https://www.virustotal.com/api/scan_url.json';

type
   TAPIRequest = class
   private
      FAPIKey: AnsiString;
      FPOSTParameters: TStringList;
      FAttachedFile: WideString;
   public
      constructor Create(AAPIKey: AnsiString);
      destructor Destroy; override;
      function SendRequest(const AURL: AnsiString; AOutStream: TStream): boolean; overload;
      function SendRequest(const URL: AnsiString): TlkJSONbase; overload;
      property POSTParameters: TStringList read FPOSTParameters;
      property AttachedFile: WideString read FAttachedFile write FAttachedFile;
   end;

function TestJSONResult(AJSON: TlkJSONbase): integer;
var
   jsr: TlkJSONbase;
begin
   Result := -3;
   jsr := AJSON.Field['result'];
   if Assigned(jsr) then begin
      Result := jsr.Value;
      if Result = -2 then begin
         raise VirusTotalAPIExceededException.Create('VirusTotal API request rate exceeded');
      end
      else if Result = -1 then begin
         raise VirusTotalInvalidAPIKeyException.Create('Invalid VirusTotal API key');
      end;
   end;
end;

{ TVirusTotalAPI }

function TVirusTotalAPI.GetReport(const AURL, AHash: AnsiString): TlkJSONbase;
var
   ms: TMemoryStream;
   r: TAPIRequest;
begin
   Result := nil;
   r := TAPIRequest.Create(FAPIKey);
   try
      r.POSTParameters.Add('resource=' + AHash);
      Result := r.SendRequest(AURL);
   finally
      FreeAndNil(r);
   end;
end;

function TVirusTotalAPI.GetFileReport(const AHash: AnsiString; AMeta, AList: TStrings): boolean;
begin
   Result := GetReport(SURLGetFileReport, AHash, AMeta, AList);
end;

function TVirusTotalAPI.GetReport(const AURL, AHash: AnsiString; AMeta, AList: TStrings): boolean;
var
   js: TlkJSONbase;
   jsReport: TlkJSONlist;
   jsPermaLink: TlkJSONstring;
   jsFileReport: TlkJSONstring;
   jsReportDate: TlkJSONstring;
   jsReportResults: TlkJSONobject;
   iResult, i: integer;
begin
   Result := false;
   js := GetReport(AURL, AHash);
   if Assigned(js) then begin
      try
         iResult := TestJSONResult(js);
         if iResult > 0 then begin
            if Assigned(js.Field['file-report']) then begin
               jsFileReport := TlkJSONstring(js.Field['file-report']);
               if Assigned(AMeta) then begin
                  AMeta.Add('file-report=' + jsFileReport.Value);
               end;
            end;
            if Assigned(js.Field['permalink']) then begin
               jsPermaLink := TlkJSONstring(js.Field['permalink']);
               if Assigned(AMeta) then begin
                  AMeta.Add('permalink=' + jsPermaLink.Value);
               end;
            end;
            if not Assigned(js.Field['report']) then begin
               Exit;
            end;
            if js.Field['report'].SelfType = jsList then begin
               jsReport := TlkJSONlist(js.Field['report']);
               if Assigned(jsReport) then begin
                  if jsReport.Count >= 2 then begin
                     if jsReport.Child[0].SelfType = jsString then begin
                        jsReportDate := TlkJSONstring(jsReport.Child[0]);
                        AMeta.Add('date=' + jsReportDate.Value);
                     end;
                     if jsReport.Child[1].SelfType = jsObject then begin
                        jsReportResults := TlkJSONobject(jsReport.Child[1]);
                        for i := 0 to Pred(jsReportResults.Count) do begin
                           AList.Add(jsReportResults.NameOf[i] + '=' + jsReportResults.getString(i));
                        end;
                     end;
                     Result := true;
                  end;
               end;
            end;
         end;
      finally
         FreeAndNil(js);
      end;
   end;
end;

function TVirusTotalAPI.GetUrlReport(const AURL: AnsiString; AMeta, AList: TStrings): boolean;
begin
   Result := GetReport(SURLGetUrlReport, AURL, AMeta, AList);
end;

function TVirusTotalAPI.ScanFile(const AFilename: WideString): TlkJSONbase;
var
   ms: TMemoryStream;
   r: TAPIRequest;
begin
   Result := nil;
   r := TAPIRequest.Create(FAPIKey);
   try
      r.AttachedFile := AFilename;
      Result := r.SendRequest(SURLScanFile);
   finally
      FreeAndNil(r);
   end;
end;

function TVirusTotalAPI.ScanFile(const AFilename: WideString; var AScanID: AnsiString): boolean;
var
   js: TlkJSONbase;
   jsScanID: TlkJSONstring;
   iResult: integer;
begin
   js := ScanFile(AFilename);
   Result := false;
   if Assigned(js) then begin
      try
         iResult := TestJSONResult(js);
         if (iResult = 1) then begin
            if Assigned(js.Field['scan_id']) then begin
               jsScanID := TlkJSONstring(js.Field['scan_id']);
               AScanID := jsScanID.Value;
               Result := true;
            end;
         end;
      finally
         FreeAndNil(js);
      end;
   end;
end;

function TVirusTotalAPI.ScanURL(const AURL: AnsiString): TlkJSONbase;
var
   ms: TMemoryStream;
   r: TAPIRequest;
begin
   Result := nil;
   r := TAPIRequest.Create(FAPIKey);
   try
      r.POSTParameters.Add('url=' + AURL);
      Result := r.SendRequest(SURLScanURL);
   finally
      FreeAndNil(r);
   end;
end;

function TVirusTotalAPI.ScanURL(const AURL: AnsiString; var AScanID: AnsiString): boolean;
var
   js: TlkJSONbase;
   jsScanID: TlkJSONstring;
   iResult: integer;
begin
   js := ScanURL(AURL);
   Result := false;
   if Assigned(js) then begin
      try
         iResult := TestJSONResult(js);
         if (iResult = 1) then begin
            if Assigned(js.Field['scan_id']) then begin
               jsScanID := TlkJSONstring(js.Field['scan_id']);
               AScanID := jsScanID.Value;
               Result := true;
            end;
         end;
      finally
         FreeAndNil(js);
      end;
   end;
end;

procedure TVirusTotalAPI.TestAPIKey;
begin
   if Length(FAPIKey) = 0 then begin
      raise VirusTotalAPIKeyMissingException.Create('The VirusTotal API needs an API key specified!');
   end;
end;

{ TAPIRequest }

constructor TAPIRequest.Create(AAPIKey: AnsiString);
begin
   FAPIKey := AAPIKey;
   FPOSTParameters := TStringList.Create;
   FPOSTParameters.StrictDelimiter := true;
   FPOSTParameters.Delimiter := '&';
   FPOSTParameters.Add('key=' + AAPIKey);
   FAttachedFile := '';
end;

destructor TAPIRequest.Destroy;
begin
   FreeAndNil(FPOSTParameters);
   inherited;
end;

function TAPIRequest.SendRequest(const URL: AnsiString): TlkJSONbase;
var
   ms: TMemoryStream;
   sOut: AnsiString;
begin
   Result := nil;
   ms := TMemoryStream.Create;
   try
      if SendRequest(URL, ms) then begin
         ms.Seek(0, soFromBeginning);
         SetLength(sOut, ms.Size);
         ms.Read(sOut[1], ms.Size);
         {$IFDEF SaferNetworking} DebugLogMessage(sOut); {$ENDIF}
         Result := TlkJSON.ParseText(sOut);
         TestJSONResult(Result);
      end;
   finally
      FreeAndNil(ms);
   end;
end;

function TAPIRequest.SendRequest(const AURL: AnsiString; AOutStream: TStream): boolean;
var
   {$IFDEF UseSynapse}
   sPostData: string;
   slPOSTParameters: TStringList;
   http: THTTPSend;
   {$ENDIF UseSynapse}
   {$IFDEF UseIndy10}
   indy: TIdCustomHTTP;
   indySSL: TIdSSLIOHandlerSocketOpenSSL;
   mp: TIdMultiPartFormDataStream;
   {$ENDIF UseIndy10}
   i: integer;
begin
   {$IFDEF UseIndy10}
   indy := TIdCustomHTTP.Create(nil);
   indySSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
   try
      {$IFDEF SaferNetworking}
      ImportIEProxyFromRegToIndy(indy, true);
      {$ENDIF SaferNetworking}
      indy.IOHandler := indySSL;
      try
         if Length(FAttachedFile) > 0 then begin
            mp := TIdMultiPartFormDataStream.Create;
            try
               for i := 0 to Pred(FPOSTParameters.Count) do begin
                  mp.AddFormField(FPOSTParameters.Names[i], FPOSTParameters.ValueFromIndex[i]);
               end;
               mp.AddFile('file', FAttachedFile, 'application/octet-stream');
               indy.Request.ContentType := 'application/x-www-form-urlencoded';
               indy.Post(AURL, mp, AOutStream);
            finally
               FreeAndNil(mp);
            end;
         end else begin
            indy.Post(AURL, FPOSTParameters, AOutStream);
         end;
         Result := true;
      except
         on E: Exception do begin
            {$IFDEF SaferNetworking} DebugLogException(E, 'TAPIRequest.SendRequest'); {$ENDIF}
            Result := false;
         end;
      end;
   finally
      FreeAndNil(indy);
      FreeAndNil(indySSL);
   end;
   {$ENDIF UseIndy10}
   {$IFDEF UseSynapse}
   slPOSTParameters := TStringList.Create;
   http := THTTPSend.Create;
   try
      slPOSTParameters.StrictDelimiter := true;
      slPOSTParameters.Delimiter := '&';
      for i := 0 to Pred(FPOSTParameters.Count) do begin
         slPOSTParameters.Add(FPOSTParameters.Names[i] + '=' + EncodeURLElement(FPOSTParameters.ValueFromIndex[i]));
      end;
      sPostData := slPOSTParameters.DelimitedText;
      http.MimeType := 'application/x-www-form-urlencoded';
      WriteStrToStream(http.Document, sPostData);
      Result := http.HTTPMethod('POST', AURL);
      Result := (http.ResultCode = 200);
      if Result then begin
         http.Document.Seek(0, soFromBeginning);
         AOutStream.Size := http.Document.Size;
         AOutStream.CopyFrom(http.Document, http.Document.Size);
      end else begin
         {$IFDEF SaferNetworking} DebugLogError('Request received http error code ' + IntToStr(http.ResultCode)); {$ENDIF}
      end;
      // Result := HttpPostURL(AURL, sPostData, AOutStream);
   finally
      FreeAndNil(slPOSTParameters);
      FreeAndNil(http);
   end;
   {$ENDIF UseSynapse}
end;

initialization

{$IFDEF SaferNetworking}
   DebugLogEnterUnitInitialization('snlAPIVirusTotal');
try
   RegisterLKJSONLicense;
   {$IFDEF UseSynapse} RegisterSynapseLicense; {$ENDIF}
   RegisterOpenSSLLicense;
finally
   DebugLogLeaveUnitInitialization('snlAPIVirusTotal');
end;
{$ENDIF SaferNetworking}

end.