fix restart/shutdown when using https
This commit is contained in:
		
					parent
					
						
							
								cdc5b4a385
							
						
					
				
			
			
				commit
				
					
						1de3d3b9c9
					
				
			
		
					 1 changed files with 16 additions and 2 deletions
				
			
		| 
						 | 
					@ -31,6 +31,7 @@ import System.Posix (signalProcess, sigTERM)
 | 
				
			||||||
import Utility.WinProcess
 | 
					import Utility.WinProcess
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
import Data.Default
 | 
					import Data.Default
 | 
				
			||||||
 | 
					import Network.URI
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Before the assistant can be restarted, have to remove our 
 | 
					{- Before the assistant can be restarted, have to remove our 
 | 
				
			||||||
 - gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also
 | 
					 - gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also
 | 
				
			||||||
| 
						 | 
					@ -78,15 +79,28 @@ newAssistantUrl repo = do
 | 
				
			||||||
		v <- tryIO $ readFile urlfile
 | 
							v <- tryIO $ readFile urlfile
 | 
				
			||||||
		case v of
 | 
							case v of
 | 
				
			||||||
			Left _ -> delayed $ waiturl urlfile
 | 
								Left _ -> delayed $ waiturl urlfile
 | 
				
			||||||
			Right url -> ifM (listening url)
 | 
								Right url -> ifM (assistantListening url)
 | 
				
			||||||
				( return url
 | 
									( return url
 | 
				
			||||||
				, delayed $ waiturl urlfile
 | 
									, delayed $ waiturl urlfile
 | 
				
			||||||
				)
 | 
									)
 | 
				
			||||||
	listening url = catchBoolIO $ fst <$> exists url def
 | 
					 | 
				
			||||||
	delayed a = do
 | 
						delayed a = do
 | 
				
			||||||
		threadDelay 100000 -- 1/10th of a second
 | 
							threadDelay 100000 -- 1/10th of a second
 | 
				
			||||||
		a
 | 
							a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					{- Checks if the assistant is listening on an url.
 | 
				
			||||||
 | 
					 -
 | 
				
			||||||
 | 
					 - Always checks http, because https with self-signed cert is problimatic.
 | 
				
			||||||
 | 
					 - warp-tls listens to http, in order to show an error page, so this works.
 | 
				
			||||||
 | 
					 -}
 | 
				
			||||||
 | 
					assistantListening :: URLString -> IO Bool
 | 
				
			||||||
 | 
					assistantListening url = catchBoolIO $ fst <$> exists url' def
 | 
				
			||||||
 | 
					  where
 | 
				
			||||||
 | 
						url' = case parseURI url of
 | 
				
			||||||
 | 
							Nothing -> url
 | 
				
			||||||
 | 
							Just uri -> show $ uri
 | 
				
			||||||
 | 
								{ uriScheme = "http:"
 | 
				
			||||||
 | 
								}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Does not wait for assistant to be listening for web connections. 
 | 
					{- Does not wait for assistant to be listening for web connections. 
 | 
				
			||||||
 -
 | 
					 -
 | 
				
			||||||
 - On windows, the assistant does not daemonize, which is why the forkIO is
 | 
					 - On windows, the assistant does not daemonize, which is why the forkIO is
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue