| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  | ! Copyright (C) 2012-2014 John Benediktsson | 
					
						
							| 
									
										
										
										
											2012-10-18 18:54:45 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  | USING: combinators combinators.short-circuit kernel math | 
					
						
							|  |  |  | math.bitwise math.parser math.vectors sequences splitting ;
 | 
					
						
							| 
									
										
										
										
											2012-10-18 18:54:45 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | IN: ip-parser | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-02-09 13:58:47 -05:00
										 |  |  | ERROR: invalid-ipv4 str ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2012-10-18 18:54:45 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : cleanup-octal ( str -- str )
 | 
					
						
							| 
									
										
										
										
											2014-02-18 10:33:54 -05:00
										 |  |  |     dup { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& | 
					
						
							| 
									
										
										
										
											2013-11-25 12:29:43 -05:00
										 |  |  |     [ rest "0o" prepend ] when ;
 | 
					
						
							| 
									
										
										
										
											2012-10-18 18:54:45 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : split-components ( str -- array )
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  |     "." split [ cleanup-octal string>number ] map ;
 | 
					
						
							| 
									
										
										
										
											2014-02-09 18:45:28 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  | : bubble ( array -- newarray )
 | 
					
						
							|  |  |  |     reverse 0 swap [ + 256 /mod ] map reverse nip ;
 | 
					
						
							| 
									
										
										
										
											2014-02-09 18:45:28 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  | : join-components ( array -- str )
 | 
					
						
							|  |  |  |     [ number>string ] map "." join ;
 | 
					
						
							| 
									
										
										
										
											2012-10-18 18:54:45 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  | : (parse-ipv4) ( str -- array )
 | 
					
						
							| 
									
										
										
										
											2012-10-18 20:01:49 -04:00
										 |  |  |     dup split-components dup length { | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  |         { 1 [ { 0 0 0 } prepend ] } | 
					
						
							|  |  |  |         { 2 [ 1 cut { 0 0 } glue ] } | 
					
						
							|  |  |  |         { 3 [ 2 cut { 0 } glue ] } | 
					
						
							|  |  |  |         { 4 [ ] } | 
					
						
							| 
									
										
										
										
											2012-10-18 20:01:49 -04:00
										 |  |  |         [ drop invalid-ipv4 ] | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  |     } case bubble nip ; inline
 | 
					
						
							| 
									
										
										
										
											2014-02-09 13:58:47 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : parse-ipv4 ( str -- ip )
 | 
					
						
							|  |  |  |     (parse-ipv4) join-components ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : ipv4-ntoa ( integer -- ip )
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  |     { -24 -16 -8 0 } [ 8 shift-mod ] with map join-components ;
 | 
					
						
							| 
									
										
										
										
											2014-02-09 13:58:47 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : ipv4-aton ( ip -- integer )
 | 
					
						
							| 
									
										
										
										
											2014-02-09 23:09:39 -05:00
										 |  |  |     (parse-ipv4) { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ;
 |