From a6a300cbbe8eb37e04644b5651f1288628bf613e Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 6 Nov 2006 23:17:09 +0000 Subject: [PATCH] * Added libcurl downloader and implemented new command style as in smart/svn/cvs git-svn-id: trunk@5270 - --- .gitattributes | 1 + utils/fppkg/fppkg.lpi | 161 +++++++++++++++++++------------------ utils/fppkg/fppkg.pp | 108 +++++++++++++++++++------ utils/fppkg/pkghandler.pp | 25 +++++- utils/fppkg/pkglibcurl.pp | 65 +++++++++++++++ utils/fppkg/pkgmessages.pp | 4 +- 6 files changed, 261 insertions(+), 103 deletions(-) create mode 100644 utils/fppkg/pkglibcurl.pp diff --git a/.gitattributes b/.gitattributes index 19e45d0355..ff2b77ac33 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7864,6 +7864,7 @@ utils/fppkg/fprepos.pp svneol=native#text/plain utils/fppkg/fpxmlrep.pp svneol=native#text/plain utils/fppkg/pkgdownload.pp svneol=native#text/plain utils/fppkg/pkghandler.pp svneol=native#text/plain +utils/fppkg/pkglibcurl.pp svneol=native#text/plain utils/fppkg/pkglnet.pas svneol=native#text/plain utils/fppkg/pkgmessages.pp svneol=native#text/plain utils/fppkg/pkgmkconv.pp svneol=native#text/plain diff --git a/utils/fppkg/fppkg.lpi b/utils/fppkg/fppkg.lpi index d046d9c220..21c1fbba41 100644 --- a/utils/fppkg/fppkg.lpi +++ b/utils/fppkg/fppkg.lpi @@ -10,8 +10,9 @@ + - + @@ -35,22 +36,26 @@ - - + + - + - - + + + + + + - + @@ -59,36 +64,36 @@ - - + + - + - + - + - - - - + + + + @@ -97,151 +102,151 @@ - - + + - - - - + + + + - + - - + + - - + + - + - + - + - - + + - - + + - - + + - - + + - + - + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + diff --git a/utils/fppkg/fppkg.pp b/utils/fppkg/fppkg.pp index 70bf4c5629..c9525c2601 100644 --- a/utils/fppkg/fppkg.pp +++ b/utils/fppkg/fppkg.pp @@ -4,20 +4,24 @@ program fppkg; uses // General +{$ifdef unix} + baseunix, +{$endif} Classes, SysUtils, TypInfo, custapp, // Repository handler objects - fprepos, fpxmlrep,fpmktype, + fprepos, fpxmlrep,fpmktype, pkgropts, // Package Handler components pkghandler, pkgmkconv, pkgdownload, pkgmessages; Type - TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload); + TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload,rmUpdate); { TMakeTool } TMakeTool = Class(TCustomApplication) Private + FDefaults: TPackagerOptions; FConvertOnly, FLogging : Boolean; FCompiler : String; @@ -26,16 +30,22 @@ Type FHaveFpmake : Boolean; FFPMakeSrc : String; FFPMakeBin : String; + FVerbose: TVerbosities; + FPackages : TStrings; Procedure Log(Msg : String); Procedure Error(Msg : String); Procedure Error(Fmt : String; Args : Array of const); Function GetCompiler : String; Public + Procedure DownloadFile(Const URL,Dest : String); + Function GetConfigFileName : String; + Procedure LoadDefaults; Procedure ProcessCommandLine; procedure CreateFPMake; procedure CompileFPMake(Extra : Boolean); Function RunFPMake : Integer; Procedure DoRun; Override; + Property Verbose : TVerbosities Read FVerbose Write FVerbose; end; EMakeToolError = Class(Exception); @@ -147,6 +157,36 @@ begin end; end; +procedure TMakeTool.DownloadFile(const URL, Dest: String); +begin + +end; + +function TMakeTool.GetConfigFileName: String; + +var + G : Boolean; + +begin + if HasOption('C','config-file') then + Result:=GetOptionValue('C','config-file') + else + begin +{$ifdef unix} + g:=(fpgetuid=0); +{$else} + G:=true; +{$endif} + Result:=GetAppConfigFile(G,False); + end +end; + +procedure TMakeTool.LoadDefaults; +begin + FDefaults:=TPackagerOptions.Create; + FDefaults.LoadFromFile(GetConfigFileName); +end; + procedure TMakeTool.ProcessCommandLine; @@ -191,44 +231,66 @@ procedure TMakeTool.ProcessCommandLine; Var I : Integer; - + GlobalOpts : Boolean; + cmd : string; + begin I:=0; FLogging:=False; FRunMode:=rmhelp; FConvertOnly:=False; + GlobalOpts:=True; + FPackages:=TStringList.Create; + // We can't use the TCustomApplication option handling, + // because they cannot handle [general opts] [command] [cmd-opts] [args] While (I0; + else if (Length(Paramstr(i))>0) and (Paramstr(I)[1]='-') then + Raise EMakeToolError.CreateFmt(SErrInvalidArgument,[I,ParamStr(i)]) + else + If GlobalOpts then + begin + // It's a command. + Cmd:=Paramstr(I); + if (Cmd='convert') then + FConvertOnly:=True + else if (Cmd='compile') then + FRunMode:=rmCompile + else if (Cmd='build') then + FRunMode:=rmBuild + else if (Cmd='install') then + FRunMode:=rmInstall + else if (cmd='clean') then + FRunMode:=rmClean + else if (cmd='archive') then + FRunMode:=rmarchive + else if (cmd='download') then + FRunMode:=rmDownload + else if (cmd='update') then + FRunMode:=rmUpdate + else + Raise EMakeToolError.CreateFmt(SErrInvalidCommand,[Cmd]); + end + else // It's a package name. + begin + FPackages.Add(Paramstr(i)); + end; end; end; - procedure TMakeTool.DoRun; begin + LoadDefaults; Try ProcessCommandLine; If FConvertOnly then diff --git a/utils/fppkg/pkghandler.pp b/utils/fppkg/pkghandler.pp index a1dfdfb86c..b89513a0b2 100644 --- a/utils/fppkg/pkghandler.pp +++ b/utils/fppkg/pkghandler.pp @@ -35,10 +35,33 @@ Type end; EPackageHandler = Class(EInstallerError); + +Function StringToVerbosity (S : String) : TVerbosity; +Function VerbosityToString (V : TVerbosity): String; + Implementation -uses pkgmessages; +uses pkgmessages,typinfo; + +function StringToVerbosity(S: String): TVerbosity; + +Var + I : integer; + +begin + I:=GetEnumValue(TypeInfo(TVerbosity),'v'+S); + If (I<>-1) then + Result:=TVerbosity(I) + else + Raise EPackageHandler.CreateFmt(SErrInvalidVerbosity,[S]); +end; + +Function VerbosityToString (V : TVerbosity): String; +begin + Result:=GetEnumName(TypeInfo(TVerbosity),Integer(V)); + Delete(Result,1,1);// Delete 'v' +end; { TPackageHandler } diff --git a/utils/fppkg/pkglibcurl.pp b/utils/fppkg/pkglibcurl.pp new file mode 100644 index 0000000000..a94b28dfbe --- /dev/null +++ b/utils/fppkg/pkglibcurl.pp @@ -0,0 +1,65 @@ +{$mode objfpc} +{$h+} +unit pkglibcurl; + +interface + +uses Classes,pkgdownload; + +Type + TLibCurlDownloader = Class(TBasePackageDownloader) + Protected + Procedure LibCurlDownload(Const URL : String; Dest : TStream); + Procedure FTPDownload(Const URL : String; Dest : TStream); override; + Procedure HTTPDownload(Const URL : String; Dest : TStream); override; + end; + +implementation + +uses sysutils,uriparser,libcurl,pkgmessages,unixtype; + +Function DoStreamWrite(Ptr : Pointer; Size : size_t; nmemb: size_t; Data : Pointer) : size_t;cdecl; + +begin + Result:=TStream(Data).Write(Ptr^,Size*nmemb); +end; + +Procedure TLibCurlDownloader.LibCurlDownload(Const URL : String; Dest : TStream); + +Var + HCurl : PCurl; + ErrorBuffer : Array[0..CURL_ERROR_SIZE] of char; + +begin + hCurl:= curl_easy_init; + if Assigned(hCurl) then + Try + curl_easy_setopt(hCurl,CURLOPT_ERRORBUFFER, [@ErrorBuffer]); + curl_easy_setopt(hCurl,CURLOPT_URL,[Pchar(URL)]); + curl_easy_setopt(hCurl,CURLOPT_WRITEFUNCTION,[@DoStreamWrite]); + curl_easy_setopt(hCurl,CURLOPT_WRITEDATA,[Pointer(Dest)]); + if Ord(curl_easy_perform(hCurl))<>0 then + Error(SErrDownloadFailed,[StrPas(@ErrorBuffer)]) + Finally + curl_easy_cleanup(hCurl); + end + else + Raise Exception.Create('Failed to initialize Curl'); +end; + + +Procedure TLibCurlDownloader.FTPDownload(Const URL : String; Dest : TStream); + +begin + LibCurlDownload(URL,Dest); +end; + +Procedure TLibCurlDownloader.HTTPDownload(Const URL : String; Dest : TStream); + +begin + LibCurlDownload(URL,Dest); +end; + +initialization + DownloaderClass:=TLibCurlDownloader; +end. \ No newline at end of file diff --git a/utils/fppkg/pkgmessages.pp b/utils/fppkg/pkgmessages.pp index d63ce83c5c..c65aa5709a 100644 --- a/utils/fppkg/pkgmessages.pp +++ b/utils/fppkg/pkgmessages.pp @@ -6,7 +6,7 @@ interface Resourcestring - // SErrInValidArgument = 'Invalid command-line argument at position %d : %s'; + SErrInValidArgument = 'Invalid command-line argument at position %d : %s'; SErrNeedArgument = 'Option at position %d (%s) needs an argument'; SErrMissingConfig = 'Missing configuration Makefile.fpc or fpmake.pp'; SErrRunning = 'The FPC make tool encountered the following error: %s'; @@ -18,6 +18,8 @@ Resourcestring SErrNoSuchFile = 'File "%s" does not exist.'; SErrWGetDownloadFailed = 'Download failed: wget reported exit status %d.'; SErrDownloadFailed = 'Download failed: %s'; + SErrInvalidVerbosity = 'Invalid verbosity string: "%s"'; + SErrInvalidCommand = 'Invalid command: %s'; SErrHTTPGetFailed = 'HTTP Download failed.'; SErrLoginFailed = 'FTP LOGIN command failed.';