Merge pull request #1750 from pharo-vcs/feature/honouring-proxy-setti…

…ngs-p11

Honouring Proxy Settings in P11

BaselineOfIceberg/BaselineOfIceberg.class.st

@@ -76,7 +76,7 @@ BaselineOfIceberg >> libgit: spec [
 		baseline: 'LibGit' 
 		with: [ 
 			spec
-				repository: 'github://pharo-vcs/libgit2-pharo-bindings:v3.0.6.1';
+				repository: 'github://pharo-vcs/libgit2-pharo-bindings:v3.0.8';
   			loads: 'default' ].
 	spec  
 		project: 'LibGit-Tests'

Iceberg-Libgit/IceGitClone.class.st

@@ -34,6 +34,8 @@ IceGitClone >> execute [
 	repo := LGitRepository on: location.
 	cloneOptions := repo cloneOptionsStructureClass withCredentialsProvider: (IceCredentialsProvider defaultForRemoteUrl: url).
 
+	Iceberg configureLGitProxyOpt: cloneOptions fetchOptions proxyOptions.
+
 	"Keeping references, because if not the GC take them."
 	checkoutOptions := cloneOptions checkoutOptions.
 	callbacks := cloneOptions fetchOptions callbacks.

Iceberg-Libgit/IceGitLocalBranch.class.st

@@ -104,32 +104,52 @@ IceGitLocalBranch >> name [
 
 { #category : #'private - pushing' }
 IceGitLocalBranch >> pushBranchToRemote: aRemote gitRemote: gitRemote progress: pushProgress [
-
-	gitRemote 
+
+	| pushOptions |
+	pushOptions := gitRemote ffiLibrary uniqueInstance
+		               pushOptionsStructureClass defaults
+		               callbacks:
+			               ((gitRemote ffiLibrary uniqueInstance
+				                 remoteCallbacksStructureClass withProvider:
+					                 (IceCredentialsProvider defaultForRemote:
+							                  aRemote))
+				                pushTransferProgress: pushProgress;
+				                yourself);
+		               yourself.
+
+	Iceberg configureLGitProxyOpt: pushOptions proxyOptions.
+
+	gitRemote
 		pushWithRefSpec: (LGitRefSpec new
-			source: self fullname;
-			destination: self fullname;
-			yourself)
-		pushOptions: (gitRemote ffiLibrary uniqueInstance pushOptionsStructureClass defaults
-			callbacks: ((gitRemote ffiLibrary uniqueInstance remoteCallbacksStructureClass withProvider: (IceCredentialsProvider defaultForRemote: aRemote)) 
-				pushTransferProgress: pushProgress; 
-				yourself);
-			yourself)
+				 source: self fullname;
+				 destination: self fullname;
+				 yourself)
+		pushOptions: pushOptions
 ]
 
 { #category : #'private - pushing' }
 IceGitLocalBranch >> pushTag: tag toRemote: aRemote gitRemote: gitRemote progress: pushProgress [
 
-	gitRemote 
+	| pushOptions |
+	pushOptions := gitRemote ffiLibrary uniqueInstance
+		               pushOptionsStructureClass defaults
+		               callbacks:
+			               ((gitRemote ffiLibrary uniqueInstance
+				                 remoteCallbacksStructureClass withProvider:
+					                 (IceCredentialsProvider defaultForRemote:
+							                  aRemote))
+				                pushTransferProgress: pushProgress;
+				                yourself);
+		               yourself.
+
+	Iceberg configureLGitProxyOpt: pushOptions proxyOptions.
+
+	gitRemote
 		pushWithRefSpec: (LGitRefSpec new
-			source: 'refs/tags/' , tag name;
-			destination: 'refs/tags/' , tag name;
-			yourself)
-		pushOptions: (gitRemote ffiLibrary uniqueInstance pushOptionsStructureClass defaults
-			callbacks: ((gitRemote ffiLibrary uniqueInstance remoteCallbacksStructureClass withProvider: (IceCredentialsProvider defaultForRemote: aRemote))
-				pushTransferProgress: pushProgress;
-				yourself);
-			yourself)
+				 source: 'refs/tags/' , tag name;
+				 destination: 'refs/tags/' , tag name;
+				 yourself)
+		pushOptions: pushOptions
 ]
 
 { #category : #'private - pushing' }

Iceberg-Libgit/IceGitRemote.class.st

@@ -49,36 +49,40 @@ IceGitRemote >> branches [
 ]
 
 { #category : #fetching }
-IceGitRemote >> fetch [
-	
+IceGitRemote >> doFetchWithRefSpec: refSpec [
+
 	localRepository handleLibgitError: [
-		[ (LGitRemote of: self repositoryHandle named: self name)
+		[
+		(LGitRemote of: self repositoryHandle named: self name)
 			lookup;
-			fetchWithCredentials: (IceCredentialsProvider defaultForRemote: self)
-			andProgressCallback: IceGitTransferProgress new ]
+			fetchWithCredentials:
+				(IceCredentialsProvider defaultForRemote: self)
+			andProgressCallback: IceGitTransferProgress new
+			refSpec: refSpec
+			proxyConfigurationBlock: [ :proxyOpt | Iceberg configureLGitProxyOpt: proxyOpt ] ]
 			on: LGitAbstractError
-			do: [ :e | e acceptError: (IceLibgitErrorVisitor onContext: self) ].
-
-		"Call post fetch to fix unknown commits"
-		localRepository postFetch ]
+			do: [ :e | e acceptError: (IceLibgitErrorVisitor onContext: self) ] ]
+]
+
+{ #category : #fetching }
+IceGitRemote >> fetch [
+
+	self doFetchWithRefSpec: nil.
+
+	"Call post fetch to fix unknown commits"
+	localRepository postFetch
 ]
 
 { #category : #fetching }
 IceGitRemote >> fetchBranch: aBranch [
-
-	localRepository handleLibgitError: [
-		[ | refSpec remote |
-		refSpec := LGitRefSpec
-			fromString:
-				('{2}:refs/remotes/{1}/{2}'
-					format:
-						{self name.
-						aBranch name}).
-		(remote := LGitRemote of: self repositoryHandle named: self name)
-			lookup;
-			fetchWithCredentials: (IceCredentialsProvider defaultForRemote: self) refSpec: refSpec ]
-			on: LGitAbstractError
-			do: [ :e | e acceptError: (IceLibgitErrorVisitor onContext: self) ] ]
+
+	| refSpec |
+	refSpec := LGitRefSpec fromString:
+		           ('{2}:refs/remotes/{1}/{2}' format: {
+				            self name.
+				            aBranch name }).
+
+	self doFetchWithRefSpec: refSpec
 ]
 
 { #category : #branches }

Iceberg-Tests/IceProxySettingsTest.class.st

@@ -0,0 +1,79 @@
+Class {
+	#name : #IceProxySettingsTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'oldNetworkSettingsHost',
+		'oldNetworkSettingsPort'
+	],
+	#category : #'Iceberg-Tests-Core-Remotes'
+}
+
+{ #category : #asserting }
+IceProxySettingsTest >> assertProxyURLExternalStringHasValue: aString [ 
+
+	| value |
+	value := Iceberg proxyURLExternalString.
+
+	self assert: value isExternalAddress.
+	self deny: value isNull.
+
+	self assert: value utf8StringFromCString equals: aString
+]
+
+{ #category : #running }
+IceProxySettingsTest >> setUp [ 
+
+	super setUp.
+
+	oldNetworkSettingsHost := NetworkSystemSettings httpProxyServer.
+	oldNetworkSettingsPort := NetworkSystemSettings httpProxyPort.	
+]
+
+{ #category : #running }
+IceProxySettingsTest >> tearDown [ 
+
+	NetworkSystemSettings httpProxyServer: oldNetworkSettingsHost.
+	NetworkSystemSettings httpProxyPort: oldNetworkSettingsPort.	
+
+	super tearDown
+]
+
+{ #category : #tests }
+IceProxySettingsTest >> testConfigureProxyOptWithCorrectProxyUrl [
+
+	| proxyOpt |
+
+	NetworkSystemSettings httpProxyServer: 'myproxy.company.com'.
+	NetworkSystemSettings httpProxyPort: 8080.
+
+	proxyOpt := LGitProxyOptions defaults.
+	Iceberg configureLGitProxyOpt: proxyOpt.
+
+	self assert: proxyOpt prim_url value equals: Iceberg proxyURLExternalString value.
+	self assert: proxyOpt prim_url utf8StringFromCString equals: 'https://myproxy.company.com:8080'.
+]
+
+{ #category : #tests }
+IceProxySettingsTest >> testEmptyHostReturnsNullPointer [
+
+	NetworkSystemSettings httpProxyServer: ''.
+
+	self assert: Iceberg proxyURLExternalString isNull.
+]
+
+{ #category : #tests }
+IceProxySettingsTest >> testHostAndDefaultPortHasCorrectAddress [
+
+	NetworkSystemSettings httpProxyServer: 'myproxy.company.com'.
+
+	self assertProxyURLExternalStringHasValue: 'https://myproxy.company.com:80'.
+]
+
+{ #category : #tests }
+IceProxySettingsTest >> testHostAndPortHasCorrectAddress [
+
+	NetworkSystemSettings httpProxyServer: 'myproxy.company.com'.
+	NetworkSystemSettings httpProxyPort: 8080.
+
+	self assertProxyURLExternalStringHasValue: 'https://myproxy.company.com:8080'.
+]

Iceberg/Iceberg.class.st

@@ -19,6 +19,7 @@ Class {
 	#superclass : #Object,
 	#classVars : [
 		'EnableMetacelloIntegration',
+		'ProxyURLExternalString',
 		'RemoteTypeSelector',
 		'ShowSystemRepositories'
 	],
@@ -64,6 +65,27 @@ Iceberg class >> bootstrapWithCommitId: commitId packageList: packageNameList [
 	repository register
 ]
 
+{ #category : #proxy }
+Iceberg class >> configureLGitProxyOpt: aLGitProxyOptions [ 
+
+	| proxyURL |
+	proxyURL := self proxyURLExternalString.
+
+	"If there is not configured proxy, let's return"
+	proxyURL isNull ifTrue: [ ^ self ].
+
+	aLGitProxyOptions prim_url: proxyURL
+]
+
+{ #category : #proxy }
+Iceberg class >> createProxyURLExternalString [
+
+	NetworkSystemSettings httpProxyServer isEmpty 
+		ifTrue: [ ^ ProxyURLExternalString := ExternalAddress null ].
+
+	ProxyURLExternalString := ExternalAddress fromString: self formatNetworkSettingsProxyServer. 
+]
+
 { #category : #settings }
 Iceberg class >> enableMetacelloIntegration [
 	^ EnableMetacelloIntegration ifNil: [ EnableMetacelloIntegration := true ]
@@ -74,6 +96,31 @@ Iceberg class >> enableMetacelloIntegration: anObject [
 	EnableMetacelloIntegration := anObject
 ]
 
+{ #category : #proxy }
+Iceberg class >> ensureProxyURLExternalString [
+
+
+	"If we have a valid string in the external memory, we check its value"
+	(ProxyURLExternalString isNotNil and: [ ProxyURLExternalString isNull not ]) ifTrue: [
+
+		"If it is the same that we want, let's just continue. If it is different, we need to free it so, we can allocate a new one"
+		ProxyURLExternalString utf8StringFromCString = self formatNetworkSettingsProxyServer
+			ifTrue: [ ^ self ]
+			ifFalse: [ ProxyURLExternalString free ] ].
+
+	^ self createProxyURLExternalString
+]
+
+{ #category : #proxy }
+Iceberg class >> formatNetworkSettingsProxyServer [
+
+	^ String streamContents: [ :s |
+		  s nextPutAll: 'https://'.
+		  s nextPutAll: NetworkSystemSettings httpProxyServer.
+		  s nextPutAll: ':'.
+		  s nextPutAll: NetworkSystemSettings httpProxyPort printString ]
+]
+
 { #category : #accessing }
 Iceberg class >> icebergRepositoriesURLs [
 	^ {
@@ -111,6 +158,13 @@ Iceberg class >> packageForCategoryNamed: categoryName [
 
 ]
 
+{ #category : #proxy }
+Iceberg class >> proxyURLExternalString [
+
+	self ensureProxyURLExternalString.
+	^ ProxyURLExternalString
+]
+
 { #category : #accessing }
 Iceberg class >> remoteTypeSelector [
 	"Should be #scpURL or #httpsURL"