From dbe254e13231dbbc353c01b2abc68f2a9e6a71ec Mon Sep 17 00:00:00 2001 From: balazs Date: Wed, 4 Jan 2017 13:51:11 +0000 Subject: [PATCH] Opkman: Submit packages to remote server. git-svn-id: trunk@53885 - --- .gitattributes | 1 + .../opkman_createrepositorypackagefr.lfm | 162 +++++++------ .../opkman_createrepositorypackagefr.pas | 223 ++++++++++++++---- .../onlinepackagemanager.lpk | 6 +- .../onlinepackagemanager.pas | 2 +- .../onlinepackagemanager/opkman_const.pas | 17 +- .../opkman_createjsonforupdates.lfm | 14 +- .../opkman_createjsonforupdates.pas | 6 - .../opkman_createrepositorypackage.lfm | 22 ++ .../opkman_downloader.pas | 4 +- .../onlinepackagemanager/opkman_options.pas | 2 +- .../opkman_serializablepackages.pas | 2 +- .../onlinepackagemanager/opkman_uploader.pas | 218 +++++++++++++++++ 13 files changed, 538 insertions(+), 141 deletions(-) create mode 100644 components/onlinepackagemanager/opkman_uploader.pas diff --git a/.gitattributes b/.gitattributes index cef649e081..40ae77e645 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3316,6 +3316,7 @@ components/onlinepackagemanager/opkman_progressfrm.pas svneol=native#text/pascal components/onlinepackagemanager/opkman_serializablepackages.pas svneol=native#text/pascal components/onlinepackagemanager/opkman_timer.pas svneol=native#text/pascal components/onlinepackagemanager/opkman_updates.pas svneol=native#text/pascal +components/onlinepackagemanager/opkman_uploader.pas svneol=native#text/pascal components/onlinepackagemanager/opkman_visualtree.pas svneol=native#text/pascal components/onlinepackagemanager/opkman_zipper.pas svneol=native#text/pascal components/onlinepackagemanager/vst/include/carbon/opkman_delphicompat.inc svneol=native#text/plain diff --git a/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.lfm b/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.lfm index e05590332f..2fc25c6660 100644 --- a/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.lfm +++ b/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.lfm @@ -1,9 +1,9 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr Left = 0 - Height = 450 + Height = 506 Top = 0 Width = 750 - ClientHeight = 450 + ClientHeight = 506 ClientWidth = 750 Color = clBtnFace ParentColor = False @@ -12,7 +12,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr DesignTop = 213 object pnMessage: TPanel Left = 247 - Height = 340 + Height = 400 Top = 65 Width = 503 Align = alClient @@ -31,7 +31,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr end object pnPackages: TPanel Left = 0 - Height = 340 + Height = 400 Top = 65 Width = 245 Align = alLeft @@ -81,23 +81,23 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr end object pnData: TPanel Left = 247 - Height = 340 + Height = 400 Top = 65 Width = 503 Align = alClient BevelOuter = bvNone - ClientHeight = 340 + ClientHeight = 400 ClientWidth = 503 TabOrder = 2 object pnPackageData: TPanel Left = 0 - Height = 151 + Height = 211 Top = 189 Width = 503 Align = alClient BevelOuter = bvNone BorderStyle = bsSingle - ClientHeight = 147 + ClientHeight = 207 ClientWidth = 499 TabOrder = 0 Visible = False @@ -324,7 +324,7 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr end object spMain: TSplitter Left = 245 - Height = 340 + Height = 400 Top = 65 Width = 2 AutoSnap = False @@ -334,75 +334,105 @@ object CreateRepositoryPackagefr: TCreateRepositoryPackagefr end object pnButtons: TPanel Left = 0 - Height = 45 - Top = 405 + Height = 41 + Top = 465 Width = 750 Align = alBottom BevelOuter = bvNone BorderStyle = bsSingle - ClientHeight = 41 + ClientHeight = 37 ClientWidth = 746 TabOrder = 5 - object bCreate: TButton - Left = 584 - Height = 26 - Top = 8 - Width = 75 - Anchors = [akTop, akRight] - Caption = 'Create' - Enabled = False - OnClick = bCreateClick - TabOrder = 3 - end - object bCancel: TButton - Left = 661 - Height = 26 - Top = 8 - Width = 75 - Anchors = [akTop, akRight] - Caption = 'Cancel' - Enabled = False - ModalResult = 2 - OnClick = bCancelClick - TabOrder = 4 - end - object cbOpen: TCheckBox - Left = 10 - Height = 19 - Top = 1 - Width = 211 - Caption = 'After create, open containing folder ' - TabOrder = 0 - end - object bOptions: TButton - Left = 507 - Height = 26 - Top = 8 - Width = 75 - Anchors = [akTop, akRight] - Caption = 'Options' - Enabled = False - OnClick = bOptionsClick - TabOrder = 2 - end - object bHelp: TButton - Left = 430 - Height = 26 - Top = 8 - Width = 75 - Anchors = [akTop, akRight] - Caption = 'Help' - Enabled = False - OnClick = bHelpClick - TabOrder = 5 - end object cbJSONForUpdates: TCheckBox Left = 10 Height = 19 - Top = 21 + Top = 9 Width = 148 Caption = 'Create JSON for updates' + TabOrder = 0 + end + object pnB: TPanel + Left = 322 + Height = 29 + Top = 2 + Width = 400 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 1 + BevelOuter = bvNone + ClientHeight = 29 + ClientWidth = 400 TabOrder = 1 + object bCancel: TButton + Left = 324 + Height = 27 + Top = 1 + Width = 75 + Align = alRight + BorderSpacing.Around = 1 + Caption = 'Cancel' + Enabled = False + ModalResult = 2 + OnClick = bCancelClick + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object bCreate: TButton + Left = 172 + Height = 27 + Top = 1 + Width = 75 + Align = alRight + BorderSpacing.Around = 1 + Caption = 'Create' + Enabled = False + OnClick = bCreateClick + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object bSubmit: TButton + Left = 248 + Height = 27 + Top = 1 + Width = 75 + Align = alRight + BorderSpacing.Around = 1 + Caption = 'Submit' + Enabled = False + OnClick = bSubmitClick + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object bOptions: TButton + Left = 96 + Height = 27 + Top = 1 + Width = 75 + Align = alRight + BorderSpacing.Around = 1 + Caption = 'Options' + Enabled = False + OnClick = bOptionsClick + ParentShowHint = False + ShowHint = True + TabOrder = 3 + end + object bHelp: TButton + Left = 20 + Height = 27 + Top = 1 + Width = 75 + Align = alRight + BorderSpacing.Around = 1 + Caption = 'Help' + Enabled = False + OnClick = bHelpClick + ParentShowHint = False + ShowHint = True + TabOrder = 4 + end end end object imTree: TImageList diff --git a/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.pas b/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.pas index fcf10acb58..bda3e1e9d0 100644 --- a/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.pas +++ b/components/onlinepackagemanager/frames/opkman_createrepositorypackagefr.pas @@ -7,7 +7,8 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Dialogs, LazFileUtils, Graphics, Menus, Buttons, Laz2_XMLCfg, opkman_VirtualTrees, - md5, fpjson, LCLIntf, EditBtn, opkman_serializablepackages, opkman_zipper; + md5, fpjson, LCLIntf, EditBtn, opkman_serializablepackages, opkman_zipper, + opkman_uploader; type PData = ^TData; @@ -33,7 +34,7 @@ type FSVNURL: String; end; - + TPackageOperation = (poCreate, poSubmit); { TCreateRepositoryPackagefr } TCreateRepositoryPackagefr = class(TFrame) @@ -42,8 +43,8 @@ type Bevel1: TBevel; bHelp: TButton; bOptions: TButton; + bSubmit: TButton; cbJSONForUpdates: TCheckBox; - cbOpen: TCheckBox; edCategories: TEdit; edPackageDir: TDirectoryEdit; edDownloadURL: TEdit; @@ -67,6 +68,7 @@ type lbOF4: TLabel; lbPackagedir: TLabel; lbSupportedWidgetSet: TLabel; + pnB: TPanel; pnButtons: TPanel; pnCategories: TPanel; pnPackageData: TPanel; @@ -82,6 +84,7 @@ type procedure bCreateClick(Sender: TObject); procedure bHelpClick(Sender: TObject); procedure bOptionsClick(Sender: TObject); + procedure bSubmitClick(Sender: TObject); procedure edPackageDirAcceptDirectory(Sender: TObject; var Value: String); procedure edPackageDirButtonClick(Sender: TObject); procedure pnBrowseResize(Sender: TObject); @@ -89,12 +92,12 @@ type private FVSTPackages: TVirtualStringTree; FVSTPackageData: TVirtualStringTree; - FCreatePressed: Boolean; FPackageZipper: TPackageZipper; FPackageDir: String; FPackageName: String; FPackageFile: String; FDestDir: String; + FPackageOperation: TPackageOperation; procedure VSTPackagesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String); procedure VSTPackagesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; @@ -118,9 +121,14 @@ type procedure EnableDisableControls(const AEnable: Boolean); procedure SaveExtraInfo(const ANode: PVirtualNode); function TranslateCategories(const AStr: String): String; - procedure CreateJSONForUpdates; + function CanCreate: Boolean; + function CreateJSON(var AErrMsg: String): Boolean; + function CreateJSONForUpdates(var AErrMsg: String): Boolean; + procedure DoOnUploadProgress(Sender: TObject; AFileName: String); + procedure DoOnUploadError(Sender: TObject; AErrMsg: String); + procedure DoOnUploadCompleted(Sender: TObject); public - procedure InitializeFrame; + procedure InitializeFrame(const ATyp: Integer = 0); procedure FinalizeFrame; end; @@ -131,11 +139,10 @@ uses opkman_const, opkman_common, opkman_options, opkman_categoriesfrm, { TCreateRepositoryPackagefr } -procedure TCreateRepositoryPackagefr.InitializeFrame; +procedure TCreateRepositoryPackagefr.InitializeFrame(const ATyp: Integer = 0); begin lbPackagedir.Caption := rsCreateRepositoryPackageFrm_lbPackageDir_Caption; pnMessage.Caption := rsCreateRepositoryPackageFrm_pnMessage_Caption; - cbOpen.Caption := rsCreateRepositoryPackageFrm_cbOpen_Caption; edCategories.Text := ''; lbLazCompatibility.Caption := rsCreateRepositoryPackageFrm_lbLazCompatibility_Caption; lbFPCCompatibility.Caption := rsCreateRepositoryPackageFrm_lbFPCCompatibility_Caption; @@ -146,9 +153,19 @@ begin lbDownloadURL.Caption := rsCreateRepositoryPackageFrm_lbDownloadURL_Caption; lbSVNURL.Caption := rsCreateRepositoryPackageFrm_lbSVNURL_Caption; bHelp.Caption := rsCreateRepositoryPackageFrm_bHelp_Caption; + bHelp.Hint := rsCreateRepositoryPackageFrm_bHelp_Hint; bOptions.Caption := rsCreateRepositoryPackageFrm_bOptions_Caption; + bOptions.Hint := rsCreateRepositoryPackageFrm_bOptions_Hint; bCreate.Caption := rsCreateRepositoryPackageFrm_bCreate_Caption; + bCreate.Hint := rsCreateRepositoryPackageFrm_bCreate_Hint; + bSubmit.Caption := rsCreateRepositoryPackageFrm_bSubmit_Caption; + bSubmit.Hint := rsCreateRepositoryPackageFrm_bSubmit_Hint; bCancel.Caption := rsCreateRepositoryPackageFrm_bCancel_Caption; + bCancel.Hint := rsCreateRepositoryPackageFrm_bCancel_Hint; + bSubmit.Visible := ATyp = 0; + cbJSONForUpdates.Visible := ATyp = 0; + pnB.Height := bCreate.Height + 1; + pnB.Top := (pnButtons.Height - pnB.Height) div 2; FVSTPackages := TVirtualStringTree.Create(nil); with FVSTPackages do @@ -230,6 +247,15 @@ end; procedure TCreateRepositoryPackagefr.FinalizeFrame; begin + if Uploader <> nil then + begin + pnMessage.Caption := rsCreateRepositoryPackageFrm_Message10; + pnMessage.Invalidate; + Application.ProcessMessages; + Uploader.StopUpload; + Uploader.WaitFor; + Uploader := nil; + end; FVSTPackages.Clear; FVSTPackages.Free; FVSTPackageData.Clear; @@ -355,11 +381,11 @@ procedure TCreateRepositoryPackagefr.EnableDisableControls( const AEnable: Boolean); begin pnBrowse.Enabled := AEnable; - cbOpen.Enabled := AEnable; cbJSONForUpdates.Enabled := AEnable; bHelp.Enabled := AEnable; bOptions.Enabled := AEnable; bCreate.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0); + bSubmit.Enabled := (AEnable) and (FVSTPackages.CheckedCount > 0); bCancel.Enabled := AEnable; end; @@ -467,7 +493,7 @@ begin end; end; -procedure TCreateRepositoryPackagefr.bCreateClick(Sender: TObject); +function TCreateRepositoryPackagefr.CanCreate: Boolean; procedure SelectAndFocusNode(const ANode: PVirtualNode); begin @@ -479,7 +505,7 @@ var Node: PVirtualNode; Data: PData; begin - FCreatePressed := True; + Result := False; Node := FVSTPackages.GetFirstSelected; if Node <> nil then SaveExtraInfo(Node); @@ -525,21 +551,36 @@ begin end; Node := FVSTPackages.GetNext(Node); end; + Result := True; +end; +procedure TCreateRepositoryPackagefr.bCreateClick(Sender: TObject); +var + RootNode: PVirtualNode; + RootData: PData; +begin + if not CanCreate then + Exit; SDD.Title := rsCreateRepositoryPackageFrm_SDDTitleDst; SDD.InitialDir := Options.LastPackagedirDst; EnableDisableControls(False); if SDD.Execute then begin + FPackageOperation := poCreate; Screen.Cursor := crHourGlass; ShowHideControls(1); - fPackageZipper := TPackageZipper.Create; - fPackageZipper.OnZipError := @DoOnZippError; - fPackageZipper.OnZipCompleted := @DoOnZipCompleted; + FPackageZipper := TPackageZipper.Create; + FPackageZipper.OnZipError := @DoOnZippError; + FPackageZipper.OnZipCompleted := @DoOnZipCompleted; FDestDir := AppendPathDelim(SDD.FileName); Options.LastPackagedirDst := SDD.FileName; Options.Changed := True; - FPackageName := StringReplace(FPackageName, ' ', '', [rfReplaceAll]); + RootNode := FVSTPackages.GetFirst; + RootData := FVSTPackages.GetNodeData(RootNode); + if RootData^.FDisplayName <> '' then + FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll]) + else + FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]); FPackageFile := FDestDir + FPackageName + '.zip'; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4; fPackageZipper.StartZip(FPackageDir, FPackageFile); @@ -548,6 +589,32 @@ begin EnableDisableControls(True); end; +procedure TCreateRepositoryPackagefr.bSubmitClick(Sender: TObject); +var + RootNode: PVirtualNode; + RootData: PData; +begin + if not CanCreate then + Exit; + FPackageOperation := poSubmit; + EnableDisableControls(False); + ShowHideControls(1); + Screen.Cursor := crHourGlass; + fPackageZipper := TPackageZipper.Create; + fPackageZipper.OnZipError := @DoOnZippError; + fPackageZipper.OnZipCompleted := @DoOnZipCompleted; + FDestDir := Options.LocalRepositoryUpdate; + RootNode := FVSTPackages.GetFirst; + RootData := FVSTPackages.GetNodeData(RootNode); + if RootData^.FDisplayName <> '' then + FPackageName := StringReplace(RootData^.FDisplayName, ' ', '', [rfReplaceAll]) + else + FPackageName := StringReplace(RootData^.FName, ' ', '', [rfReplaceAll]); + FPackageFile := FDestDir + FPackageName + '.zip'; + pnMessage.Caption := rsCreateRepositoryPackageFrm_Message4; + fPackageZipper.StartZip(FPackageDir, FPackageFile); +end; + procedure TCreateRepositoryPackagefr.bHelpClick(Sender: TObject); begin OpenURL(cHelpPage_CreateRepositoryPackage); @@ -803,7 +870,7 @@ begin Result := AStr; end; -procedure TCreateRepositoryPackagefr.CreateJSONForUpdates; +function TCreateRepositoryPackagefr.CreateJSONForUpdates(var AErrMsg: String): Boolean; var RootNode, Node: PVirtualNode; RootData, Data: PData; @@ -811,9 +878,12 @@ var Ms: TMemoryStream; UpdatePackage: TUpdatePackage; UpdatePackageFiles: TUpdatePackageFiles; - FileName: String; - ErrMsg: String; begin + Result := False; + pnMessage.Caption := rsCreateRepositoryPackageFrm_Message6; + pnMessage.Invalidate; + Application.ProcessMessages; + Sleep(2000); UpdatePackage := TUpdatePackage.Create; try RootNode := FVSTPackages.GetFirst; @@ -822,10 +892,6 @@ begin RootData := FVSTPackages.GetNodeData(RootNode); UpdatePackage.UpdatePackageData.Name := RootData^.FName; UpdatePackage.UpdatePackageData.DownloadZipURL := RootData^.FDownloadURL; - if RootData^.FDisplayName <> '' then - FileName := FDestDir + 'update_' + RootData^.FDisplayName + '.json' - else - FileName := FDestDir + 'update_' + RootData^.FName + '.json'; Node := FVSTPackages.GetFirstChild(RootNode); while Assigned(Node) do begin @@ -849,23 +915,20 @@ begin try Ms.Write(Pointer(JSON)^, Length(JSON)); Ms.Position := 0; - Ms.SaveToFile(FileName); + Ms.SaveToFile(FDestDir + 'update_' + FPackageName + '.json'); finally MS.Free; end; - MessageDlgEx(rsCreateJSONForUpdatesFrm_Message4, mtInformation, [mbOk], TForm(Self.Parent)); + Result := True; end else - begin - ErrMsg := StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]); - MessageDlgEx(rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + ErrMsg + '"', mtError, [mbOk], TForm(Self.Parent)); - end; + AErrMsg := rsCreateJSONForUpdatesFrm_Error1 + sLineBreak + '"' + StringReplace(UpdatePackage.LastError, '"', '', [rfReplaceAll]) + '"'; finally UpdatePackage.Free; end; end; -procedure TCreateRepositoryPackagefr.DoOnZipCompleted(Sender: TObject); +function TCreateRepositoryPackagefr.CreateJSON(var AErrMsg: String): Boolean; var SerializablePackages: TSerializablePackages; Package: TPackage; @@ -874,13 +937,12 @@ var RootData, Data: PData; JSON: TJSONStringType; MS: TMemoryStream; - ErrMsg: String; - CanClose: Boolean; begin - CanClose := False; + Result := False; pnMessage.Caption := rsCreateRepositoryPackageFrm_Message5; pnMessage.Invalidate; - Screen.Cursor := crDefault; + Application.ProcessMessages; + Sleep(2000); SerializablePackages := TSerializablePackages.Create; try RootNode := FVSTPackages.GetFirst; @@ -927,8 +989,6 @@ begin Node := FVSTPackages.GetNextSibling(Node); end; end; - ShowHideControls(2); - EnableDisableControls(True); if SerializablePackages.Count > 0 then begin JSON := ''; @@ -939,32 +999,99 @@ begin MS.Write(Pointer(JSON)^, Length(JSON)); MS.Position := 0; MS.SaveToFile(FDestDir + FPackageName + '.json'); - MessageDlgEx(rsCreateRepositoryPackageFrm_Message6, mtInformation, [mbOk], TForm(Self.Parent)); - CanClose := True; + Result := True; finally MS.Free; end; end else - begin - ErrMsg := StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]); - MessageDlgEx(rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + ErrMsg + '"', mtError, [mbOk], TForm(Self.Parent)); - end; + AErrMsg := rsCreateRepositoryPackageFrm_Error2 + sLineBreak + '"' + StringReplace(SerializablePackages.LastError, '"', '', [rfReplaceAll]) + '"' end; finally SerializablePackages.Free; end; - if cbJSONForUpdates.Checked then - CreateJSONForUpdates; - if CanClose then +end; + +procedure TCreateRepositoryPackagefr.DoOnZipCompleted(Sender: TObject); +var + ErrMsg: String; +begin + ErrMsg := ''; + if not CreateJSON(ErrMsg) then begin - if cbOpen.Checked then - OpenDocument(FDestDir); - TForm(Self.Parent).ModalResult := mrOk; - TForm(Self.Parent).Close; + MessageDlgEx(ErrMsg, mtError, [mbOk], TForm(Self.Parent)); + Exit; + end; + + if cbJSONForUpdates.Checked then + begin + ErrMsg := ''; + if not CreateJSONForUpdates(ErrMsg) then + begin + MessageDlgEx(ErrMsg, mtError, [mbOk], TForm(Self.Parent)); + Exit; + end; + end; + + case FPackageOperation of + poCreate: + begin + Screen.Cursor := crDefault; + ShowHideControls(2); + EnableDisableControls(True); + MessageDlgEx(rsCreateRepositoryPackageFrm_Message7, mtInformation, [mbOk], TForm(Self.Parent)); + TForm(Self.Parent).ModalResult := mrOk; + TForm(Self.Parent).Close; + end; + poSubmit: + begin + Uploader := TUploader.Create; + Uploader.OnUploadProgress := @DoOnUploadProgress; + Uploader.OnUploadError := @DoOnUploadError; + Uploader.OnUploadCompleted := @DoOnUploadCompleted; + if cbJSONForUpdates.Checked then + Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FDestDir + FPackageName + '.json', FDestDir + 'update_' + FPackageName + '.json') + else + Uploader.StartUpload(cSubmitURL_Zip, cSubmitURL_JSON, FPackageFile, FDestDir + FPackageName + '.json', '') + end; end; end; +procedure TCreateRepositoryPackagefr.DoOnUploadProgress(Sender: TObject; + AFileName: String); +begin + pnMessage.Caption := Format(rsCreateRepositoryPackageFrm_Message8, [AFileName]); + pnMessage.Invalidate; + Application.ProcessMessages; +end; + +procedure TCreateRepositoryPackagefr.DoOnUploadError(Sender: TObject; + AErrMsg: String); +begin + Screen.Cursor := crDefault; + ShowHideControls(2); + EnableDisableControls(True); + MessageDlgEx(AErrMsg, mtError, [mbOk], TForm(Self.Parent)); +end; + +procedure TCreateRepositoryPackagefr.DoOnUploadCompleted(Sender: TObject); +begin + Screen.Cursor := crDefault; + ShowHideControls(2); + EnableDisableControls(True); + Uploader := nil; + if FileExistsUTF8(FPackageFile) then + DeleteFileUTF8(FPackageFile); + if FileExistsUTF8(FDestDir + FPackageName + '.json') then + DeleteFileUTF8(FDestDir + FPackageName + '.json'); + if FileExistsUTF8(FDestDir + 'update_' + FPackageName + '.json') then + DeleteFileUTF8(FDestDir + 'update_' + FPackageName + '.json'); + MessageDlgEx(rsCreateRepositoryPackageFrm_Message9, mtInformation, [mbOk], TForm(Self.Parent)); + TForm(Self.Parent).ModalResult := mrOk; + TForm(Self.Parent).Close; +end; + + end. diff --git a/components/onlinepackagemanager/onlinepackagemanager.lpk b/components/onlinepackagemanager/onlinepackagemanager.lpk index bf249aa25e..0fcefa6135 100644 --- a/components/onlinepackagemanager/onlinepackagemanager.lpk +++ b/components/onlinepackagemanager/onlinepackagemanager.lpk @@ -20,7 +20,7 @@ - + @@ -103,6 +103,10 @@ + + + + diff --git a/components/onlinepackagemanager/onlinepackagemanager.pas b/components/onlinepackagemanager/onlinepackagemanager.pas index b409ccd90e..5d4f781cab 100644 --- a/components/onlinepackagemanager/onlinepackagemanager.pas +++ b/components/onlinepackagemanager/onlinepackagemanager.pas @@ -14,7 +14,7 @@ uses opkman_installer, opkman_packagelistfrm, opkman_options, opkman_createrepositorypackage, opkman_categoriesfrm, opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdates, - LazarusPackageIntf; + opkman_uploader, LazarusPackageIntf; implementation diff --git a/components/onlinepackagemanager/opkman_const.pas b/components/onlinepackagemanager/opkman_const.pas index 45711e6e0d..a1db438b6c 100644 --- a/components/onlinepackagemanager/opkman_const.pas +++ b/components/onlinepackagemanager/opkman_const.pas @@ -53,6 +53,8 @@ const cOpenSSLURL = 'http://packages.lazarus-ide.org/openssl-1.0.2j-i386-win32.zip'; {$endif} cExtractDir = 'ExtractDir'; + cSubmitURL_Zip = 'aHR0cDovL2xhemFydXNvcG0uMDAwd2ViaG9zdGFwcC5jb20vemlwLnBocA=='; + cSubmitURL_JSON = 'aHR0cDovL2xhemFydXNvcG0uMDAwd2ViaG9zdGFwcC5jb20vanNvbi5waHA='; resourcestring //package manager @@ -287,7 +289,6 @@ resourcestring //createrepositorypackage form rsCreateRepositoryPackageFrm_Caption = 'Create repository package'; rsCreateRepositoryPackageFrm_pnMessage_Caption = 'Please wait...'; - rsCreateRepositoryPackageFrm_cbOpen_Caption = 'Open containing folder after creation'; rsCreateRepositoryPackageFrm_lbPackageDir_Caption = 'Package directory:'; rsCreateRepositoryPackageFrm_pnCaption_Caption0 = 'Available packages'; rsCreateRepositoryPackageFrm_pnCaption_Caption1 = 'Description'; @@ -306,24 +307,34 @@ resourcestring rsCreateRepositoryPackageFrm_Error0 = 'Error reading package'; rsCreateRepositoryPackageFrm_Error1 = 'Cannot create zip file:'; rsCreateRepositoryPackageFrm_Error2 = 'Cannot create JSON file:'; + rsCreateRepositoryPackageFrm_Error3 = 'Cannot send file: "%s"'; rsCreateRepositoryPackageFrm_Message0 = 'Please select a category for package:'; rsCreateRepositoryPackageFrm_Message1 = 'Please enter supported Lazarus versions for package:'; rsCreateRepositoryPackageFrm_Message2 = 'Please enter supported FPC versions for package:'; rsCreateRepositoryPackageFrm_Message3 = 'Please enter supported widgetsets for package:'; rsCreateRepositoryPackageFrm_Message4 = 'Compressing package. Please wait...'; rsCreateRepositoryPackageFrm_Message5 = 'Creating JSON. Please wait...'; - rsCreateRepositoryPackageFrm_Message6 = 'Repository package successfully created.'; + rsCreateRepositoryPackageFrm_Message6 = 'Creating JSON for updates. Please wait...'; + rsCreateRepositoryPackageFrm_Message7 = 'Repository package successfully created.'; + rsCreateRepositoryPackageFrm_Message8 = 'Sending files("%s"). Please wait...'; + rsCreateRepositoryPackageFrm_Message9 = 'Files successfully sent. Thank you for submitting packages!' + sLineBreak + 'Your request will be processed in 24 hours.'; + rsCreateRepositoryPackageFrm_Message10 = 'Canceling upload. Please wait...'; rsCreateRepositoryPackageFrm_bHelp_Caption = 'Help'; + rsCreateRepositoryPackageFrm_bHelp_Hint = 'Open help'; rsCreateRepositoryPackageFrm_bOptions_Caption = 'Options'; + rsCreateRepositoryPackageFrm_bOptions_Hint = 'Open options dialog'; rsCreateRepositoryPackageFrm_bCreate_Caption = 'Create'; + rsCreateRepositoryPackageFrm_bCreate_Hint = 'Create files locally'; + rsCreateRepositoryPackageFrm_bSubmit_Caption = 'Submit'; + rsCreateRepositoryPackageFrm_bSubmit_Hint = 'Submit files to remote server'; rsCreateRepositoryPackageFrm_bCancel_Caption = 'Cancel'; + rsCreateRepositoryPackageFrm_bCancel_Hint = 'Close this dialog'; //createupdatejson rsCreateJSONForUpdatesFrm_Caption = 'Create update JSON for package:'; rsCreateJSONForUpdatesFrm_bHelp_Caption = 'Help'; rsCreateJSONForUpdatesFrm_bCreate_Caption = 'Create'; rsCreateJSONForUpdatesFrm_bClose_Caption = 'Cancel'; - rsCreateJSONForUpdatesFrm_cbOpen_Caption = 'Open containing folder after creation'; rsCreateJSONForUpdatesFrm_lbLinkToZip_Caption = 'Link to the package zip file'; rsCreateJSONForUpdatesFrm_bTest_Caption = 'Test'; rsCreateJSONForUpdatesFrm_Column0_Text = 'PackageFileName'; diff --git a/components/onlinepackagemanager/opkman_createjsonforupdates.lfm b/components/onlinepackagemanager/opkman_createjsonforupdates.lfm index abfa5f42bb..48c7859bcf 100644 --- a/components/onlinepackagemanager/opkman_createjsonforupdates.lfm +++ b/components/onlinepackagemanager/opkman_createjsonforupdates.lfm @@ -26,7 +26,7 @@ object CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm ClientWidth = 580 TabOrder = 1 object bCreate: TButton - Left = 414 + Left = 415 Height = 26 Top = 8 Width = 75 @@ -45,23 +45,15 @@ object CreateJSONForUpdatesFrm: TCreateJSONForUpdatesFrm ModalResult = 2 TabOrder = 1 end - object cbOpen: TCheckBox - Left = 15 - Height = 19 - Top = 12 - Width = 211 - Caption = 'After create, open containing folder ' - TabOrder = 2 - end object bHelp: TButton - Left = 336 + Left = 339 Height = 26 Top = 8 Width = 75 Anchors = [akTop, akRight] Caption = 'Help' OnClick = bHelpClick - TabOrder = 3 + TabOrder = 2 end end object pnTop: TPanel diff --git a/components/onlinepackagemanager/opkman_createjsonforupdates.pas b/components/onlinepackagemanager/opkman_createjsonforupdates.pas index 97d3535224..ae58dc234e 100644 --- a/components/onlinepackagemanager/opkman_createjsonforupdates.pas +++ b/components/onlinepackagemanager/opkman_createjsonforupdates.pas @@ -18,7 +18,6 @@ type bCreate: TButton; bHelp: TButton; bTest: TButton; - cbOpen: TCheckBox; edLinkToZip: TEdit; imTree: TImageList; lbLinkToZip: TLabel; @@ -76,7 +75,6 @@ begin bCreate.Caption := rsCreateJSONForUpdatesFrm_bCreate_Caption; bHelp.Caption := rsCreateJSONForUpdatesFrm_bHelp_Caption; bClose.Caption := rsCreateJSONForUpdatesFrm_bClose_Caption; - cbOpen.Caption := rsCreateJSONForUpdatesFrm_cbOpen_Caption; FVST := TVirtualStringTree.Create(nil); with FVST do @@ -225,11 +223,7 @@ begin end; end; if CanClose then - begin - if cbOpen.Checked then - OpenDocument(ExtractFilePath(SD.FileName)); Close - end; end; procedure TCreateJSONForUpdatesFrm.bHelpClick(Sender: TObject); diff --git a/components/onlinepackagemanager/opkman_createrepositorypackage.lfm b/components/onlinepackagemanager/opkman_createrepositorypackage.lfm index 3518623eff..2c5e800ce0 100644 --- a/components/onlinepackagemanager/opkman_createrepositorypackage.lfm +++ b/components/onlinepackagemanager/opkman_createrepositorypackage.lfm @@ -16,6 +16,28 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm Position = poOwnerFormCenter LCLVersion = '1.7' inline frCreateRep: TCreateRepositoryPackagefr + Height = 450 Align = alClient + ClientHeight = 450 + inherited pnMessage: TPanel + Height = 336 + end + inherited pnPackages: TPanel + Height = 336 + end + inherited pnData: TPanel + Height = 336 + ClientHeight = 336 + inherited pnPackageData: TPanel + Height = 147 + ClientHeight = 143 + end + end + inherited spMain: TSplitter + Height = 336 + end + inherited pnButtons: TPanel + Top = 401 + end end end diff --git a/components/onlinepackagemanager/opkman_downloader.pas b/components/onlinepackagemanager/opkman_downloader.pas index 12b96b13c2..0741646970 100644 --- a/components/onlinepackagemanager/opkman_downloader.pas +++ b/components/onlinepackagemanager/opkman_downloader.pas @@ -30,9 +30,7 @@ interface uses Classes, SysUtils, fpjson, opkman_httpclient, opkman_timer, opkman_common, - opkman_serializablepackages, - - dialogs; + opkman_serializablepackages; type TDownloadType = (dtJSON, dtPackage, dtUpdate); diff --git a/components/onlinepackagemanager/opkman_options.pas b/components/onlinepackagemanager/opkman_options.pas index 3ae97c5d0b..9d9d55f68c 100644 --- a/components/onlinepackagemanager/opkman_options.pas +++ b/components/onlinepackagemanager/opkman_options.pas @@ -116,7 +116,7 @@ begin FLocalUpdateDefault := LocalRepo + AppendPathDelim(cLocalRepositoryUpdate); FXML := TXMLConfig.Create(AFileName); - if FileExists(AFileName) then + if FileExistsUTF8(AFileName) then begin Load; if FLocalRepositoryPackages = '' then diff --git a/components/onlinepackagemanager/opkman_serializablepackages.pas b/components/onlinepackagemanager/opkman_serializablepackages.pas index f4ef8e2eaf..5b5ef2c7d9 100644 --- a/components/onlinepackagemanager/opkman_serializablepackages.pas +++ b/components/onlinepackagemanager/opkman_serializablepackages.pas @@ -1432,7 +1432,7 @@ begin end; paUpdate: begin - if FileExists(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName) then + if FileExistsUTF8(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName) then DeleteFile(Options.LocalRepositoryUpdate + Items[I].RepositoryFileName) end; end; diff --git a/components/onlinepackagemanager/opkman_uploader.pas b/components/onlinepackagemanager/opkman_uploader.pas new file mode 100644 index 0000000000..015758fe56 --- /dev/null +++ b/components/onlinepackagemanager/opkman_uploader.pas @@ -0,0 +1,218 @@ +{ +*************************************************************************** +* * +* This source is free software; you can redistribute it and/or modify * +* it under the terms of the GNU General Public License as published by * +* the Free Software Foundation; either version 2 of the License, or * +* (at your option) any later version. * +* * +* This code is distributed in the hope that it will be useful, but * +* WITHOUT ANY WARRANTY; without even the implied warranty of * +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * +* General Public License for more details. * +* * +* A copy of the GNU General Public License is available on the World * +* Wide Web at . You can also * +* obtain it by writing to the Free Software Foundation, * +* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * +* * +*************************************************************************** + +Author: Balázs Székely +Abstract: + Implementation of the package uploader class. +} +unit opkman_uploader; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpjson, base64, LazFileUtils, opkman_httpclient, + + dialogs; + +type + TOnUploadProgress = procedure(Sender: TObject; AFileName: String) of object; + TOnUploadError = procedure(Sender: TObject; AErrMsg: String) of object; + + { TUploader } + + TUploader = class(TThread) + private + FOnUploadProgress: TOnUploadProgress; + FOnUploadError: TOnUploadError; + FOnUploadCompleted: TNotifyEvent; + FHTTPClient: TFPHTTPClient; + FNeedToBreak: Boolean; + FFileName: String; + FURLZip: String; + FURLJSON: String; + FZip: String; + FJSON: String; + FJSONUpdate: String; + procedure DoOnUploadProgress; + procedure DoOnUploadError; + procedure DoOnUploadCompleted; + function PostFile(const AURL, AFieldName, AFileName: String): Boolean; + protected + procedure Execute; override; + public + constructor Create; + destructor Destroy; override; + procedure StartUpload(AURLZip, AURLJSON, AZip, AJSON, AJSONUpdate: String); + procedure StopUpload; + published + property OnUploadProgress: TOnUploadProgress read FOnUploadProgress write FOnUploadProgress; + property OnUploadError: TOnUploadError read FOnUploadError write FOnUploadError; + property OnUploadCompleted: TNotifyEvent read FOnUploadCompleted write FOnUploadCompleted; + property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak; + end; + + +var + Uploader: TUploader = nil; + +implementation +uses opkman_options, opkman_const; + +{ TUploader } + +procedure TUploader.DoOnUploadProgress; +begin + if Assigned(FOnUploadProgress) then + FOnUploadProgress(Self, FFileName); +end; + +procedure TUploader.DoOnUploadError; +begin + if Assigned(FOnUploadError) then + FOnUploadError(Self, Format(rsCreateRepositoryPackageFrm_Error3, [FFileName])); +end; + +procedure TUploader.DoOnUploadCompleted; +begin + if Assigned(FOnUploadCompleted) then + FOnUploadCompleted(Self); +end; + +function TUploader.PostFile(const AURL, AFieldName, AFileName: String): Boolean; +var + SS: TStringStream; +begin + Result := False; + SS := TStringStream.Create(''); + try + FHTTPClient := TFPHTTPClient.Create(nil); + try + if Options.ProxyEnabled then + begin + FHTTPClient.Proxy.Host:= Options.ProxyServer; + FHTTPClient.Proxy.Port:= Options.ProxyPort; + FHTTPClient.Proxy.UserName:= Options.ProxyUser; + FHTTPClient.Proxy.Password:= Options.ProxyPassword; + end; + try + FHttpClient.FileFormPost(AURL, AFieldName, AFileName, SS); + except + end; + case AFieldName of + 'zip' : Result := SS.DataString = 'zipok'; + 'json': Result := SS.DataString = 'jsonok'; + end; + finally + FHTTPClient.Free; + FHTTPClient := nil; + end; + finally + SS.Free; + end; +end; + +procedure TUploader.Execute; +var + CanGo: Boolean; +begin + FFileName := ExtractFileName(FZip); + CanGo := FileExistsUTF8(FZip); + if CanGo then + begin + Synchronize(@DoOnUploadProgress); + CanGo := PostFile(FURLZip, 'zip', FZip); + end; + if (not CanGo) and (not FNeedToBreak) then + begin + Synchronize(@DoOnUploadError); + Exit; + end; + if FNeedToBreak then + Exit; + + FFileName := ExtractFileName(FJSON); + CanGo := FileExistsUTF8(FJSON); + if CanGo then + begin + Synchronize(@DoOnUploadProgress); + CanGo := PostFile(FURLJSON, 'json', FJSON); + Sleep(2000); + end; + if (not CanGo) and (not FNeedToBreak) then + begin + Synchronize(@DoOnUploadError); + Exit; + end; + if FNeedToBreak then + Exit; + + if FJSONUpdate <> '' then + begin + FFileName := ExtractFileName(FJSONUpdate); + CanGo := FileExistsUTF8(FJSONUpdate); + if CanGo then + begin + Synchronize(@DoOnUploadProgress); + CanGo := PostFile(FURLJSON, 'json', FJSONUpdate); + Sleep(2000); + end; + if (not CanGo) and (not FNeedToBreak) then + begin + Synchronize(@DoOnUploadError); + Exit; + end; + end; + if not FNeedToBreak then + Synchronize(@DoOnUploadCompleted); +end; + +constructor TUploader.Create; +begin + inherited Create(True); + FreeOnTerminate := True; +end; + +destructor TUploader.Destroy; +begin + // + inherited Destroy; +end; + +procedure TUploader.StartUpload(AURLZip, AURLJSON, AZip, AJSON, AJSONUpdate: String); +begin + FURLZip := DecodeStringBase64(AURLZip); + FURLJSON := DecodeStringBase64(AURLJSON); + FZip := AZip; + FJSON := AJSON; + FJSONUpdate := AJSONUpdate; + Start; +end; + +procedure TUploader.StopUpload; +begin + if Assigned(FHTTPClient) then + FHTTPClient.NeedToBreak := True; + FNeedToBreak := True; +end; + +end. +