2016-04-13 16:06:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors fry ftp.server io.encodings.ascii io.files
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.pathnames io.servers kernel tools.test urls ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-16 01:29:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								FROM: ftp.client => ftp-get ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: ftp.server.tests
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: test-file-contents "Files are so boring anymore."
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: create-test-file ( -- path )
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-13 16:06:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    test-file-contents "ftp.server" [ ascii set-file-contents ] keep ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-04 13:32:42 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: test-ftp-server ( quot: ( server path -- ) -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    '[
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "." 0 <ftp-server> [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            "ftp://localhost" >url insecure-addr set-url-addr
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                "ftp" >>protocol
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                create-test-file >>path
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                @
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] with-threaded-server
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-test-directory ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-04 13:32:42 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ t } [
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-15 18:52:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        ! give client its own directory so we don't overwrite the ftp server's file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ ftp-get ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ path>> file-name ascii file-contents ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] with-test-directory
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] test-ftp-server test-file-contents =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-02 13:34:01 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2016-04-15 18:52:06 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        ! give client its own directory so we don't overwrite the ftp server's file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            "/" >>path
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ ftp-get ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ path>> file-name ascii file-contents ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] with-test-directory
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] test-ftp-server test-file-contents =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] must-fail
							 |