mason: make upload timeout configurable, bump default to 1 hour for erg's mom's dialup
							parent
							
								
									5378f2a0c7
								
							
						
					
					
						commit
						77db248759
					
				| 
						 | 
				
			
			@ -38,12 +38,17 @@ M: unix (really-delete-tree) delete-tree ;
 | 
			
		|||
    [ iota ] dip
 | 
			
		||||
    '[ drop @ f ] attempt-all drop ; inline
 | 
			
		||||
 | 
			
		||||
: upload-process ( process -- )
 | 
			
		||||
    #! Give network operations and shell commands at most
 | 
			
		||||
    #! 30 minutes to complete, to catch hangs.
 | 
			
		||||
    >process upload-timeout get >>timeout try-output-process ;
 | 
			
		||||
 | 
			
		||||
:: upload-safely ( local username host remote -- )
 | 
			
		||||
    remote ".incomplete" append :> temp
 | 
			
		||||
    { username "@" host ":" temp } concat :> scp-remote
 | 
			
		||||
    scp-command get :> scp
 | 
			
		||||
    ssh-command get :> ssh
 | 
			
		||||
    5 [ { scp local scp-remote } short-running-process ] retry
 | 
			
		||||
    5 [ { scp local scp-remote } upload-process ] retry
 | 
			
		||||
    5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry ;
 | 
			
		||||
 | 
			
		||||
: eval-file ( file -- obj )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: system io.files io.pathnames namespaces kernel accessors
 | 
			
		||||
assocs ;
 | 
			
		||||
USING: calendar system io.files io.pathnames namespaces kernel
 | 
			
		||||
accessors assocs ;
 | 
			
		||||
IN: mason.config
 | 
			
		||||
 | 
			
		||||
! (Optional) Location for build directories
 | 
			
		||||
| 
						 | 
				
			
			@ -97,6 +97,10 @@ SYMBOL: upload-username
 | 
			
		|||
! Directory with binary packages.
 | 
			
		||||
SYMBOL: upload-directory
 | 
			
		||||
 | 
			
		||||
! Upload timeout
 | 
			
		||||
SYMBOL: upload-timeout
 | 
			
		||||
1 hours upload-timeout set-global
 | 
			
		||||
 | 
			
		||||
! Optional: override ssh and scp command names
 | 
			
		||||
SYMBOL: scp-command
 | 
			
		||||
scp-command [ "scp" ] initialize
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue