| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  | USING: calendar ftp.server io.encodings.ascii io.files | 
					
						
							|  |  |  | io.files.unique namespaces threads tools.test kernel | 
					
						
							| 
									
										
										
										
											2010-09-27 20:12:33 -04:00
										 |  |  | io.servers ftp.client accessors urls | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  | io.pathnames io.directories sequences fry io.backend | 
					
						
							|  |  |  | continuations ;
 | 
					
						
							| 
									
										
										
										
											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 )
 | 
					
						
							|  |  |  |     test-file-contents | 
					
						
							|  |  |  |     "ftp.server" "test" make-unique-file | 
					
						
							| 
									
										
										
										
											2009-10-28 18:25:50 -04:00
										 |  |  |     [ ascii set-file-contents ] [ normalize-path ] bi ;
 | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : test-ftp-server ( quot -- )
 | 
					
						
							|  |  |  |     '[ | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         current-temporary-directory get
 | 
					
						
							|  |  |  |         0 <ftp-server> [ | 
					
						
							| 
									
										
										
										
											2010-10-07 02:00:38 -04:00
										 |  |  |             "ftp://localhost" >url insecure-addr set-url-addr | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  |                 "ftp" >>protocol | 
					
						
							|  |  |  |                 create-test-file >>path | 
					
						
							| 
									
										
										
										
											2010-09-04 21:54:39 -04:00
										 |  |  |                 @ | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         ] with-threaded-server | 
					
						
							|  |  |  |     ] cleanup-unique-directory ; inline
 | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | [ t ] | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |     [ | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         [ | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  |             [ ftp-get ] [ path>> file-name ascii file-contents ] bi
 | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         ] cleanup-unique-working-directory | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  |     ] test-ftp-server test-file-contents =
 | 
					
						
							|  |  |  | ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | [ | 
					
						
							|  |  |  |      | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         "/" >>path | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         [ | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  |             [ ftp-get ] [ path>> file-name ascii file-contents ] bi
 | 
					
						
							| 
									
										
										
										
											2010-09-19 14:38:02 -04:00
										 |  |  |         ] cleanup-unique-working-directory | 
					
						
							| 
									
										
										
										
											2009-02-18 16:29:06 -05:00
										 |  |  |     ] test-ftp-server test-file-contents =
 | 
					
						
							|  |  |  | ] must-fail |