Read and write to /etc/hosts
TL;DR: - Rename website-blocker to url-blocker - Add a README.md - Reads and writes to /etc/hosts
This commit is contained in:
		
							parent
							
								
									75595b0126
								
							
						
					
					
						commit
						946764f6bd
					
				
					 8 changed files with 182 additions and 25 deletions
				
			
		|  | @ -43,9 +43,9 @@ newtype Hour = Hour { getHour :: Int } deriving (Show, Eq, Generic) | |||
| 
 | ||||
| newtype Minute = Minute { getMinute :: Int } deriving (Show, Eq, Generic) | ||||
| 
 | ||||
| data EtcHostEntry = EtcHostEntry { ip :: IPAddress | ||||
|                                  , domains :: [Domain] | ||||
|                                  } deriving (Show) | ||||
| data EtcHostsEntry = EtcHostsEntry { ip :: IPAddress | ||||
|                                    , domains :: [Domain] | ||||
|                                    } deriving (Show) | ||||
| 
 | ||||
| -- | Write these in terms of your system's local time (i.e. `date`). | ||||
| data TimeSlot = TimeSlot { beg :: (Hour, Minute) | ||||
|  | @ -103,6 +103,12 @@ instance Aeson.FromJSON Rule where | |||
| -- Functions | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| -- | Pipe operator | ||||
| (|>) :: a -> (a -> b) -> b | ||||
| (|>) a f = f a | ||||
| infixl 1 |> | ||||
| 
 | ||||
| -- | Returns True if the current time falls within any of the `timeslots`. | ||||
| isWithinTimeSlot :: LocalTime.LocalTime -> [TimeSlot] -> Bool | ||||
| isWithinTimeSlot date timeslots = | ||||
|   List.any withinTimeSlot timeslots | ||||
|  | @ -115,51 +121,90 @@ isWithinTimeSlot date timeslots = | |||
|             LocalTime.localTimeOfDay date | ||||
|       in (todHour > ah) && (todMin > am) && (todHour < bh) && (todMin < bm) | ||||
| 
 | ||||
| -- | Returns True if `day` is the same day as today. | ||||
| isToday :: LocalTime.LocalTime -> Calendar.DayOfWeek -> Bool | ||||
| isToday date day = Calendar.dayOfWeek (LocalTime.localDay date) == day | ||||
| isToday date day = today == day | ||||
|   where | ||||
|     today = Calendar.dayOfWeek (LocalTime.localDay date) | ||||
| 
 | ||||
| isAllowed :: LocalTime.LocalTime -> [Allowance] -> Bool | ||||
| isAllowed _ [] = False | ||||
| isAllowed date allowances = do | ||||
| -- | Returns True if a list of none of the `allowances` are valid. | ||||
| shouldBeBlocked :: LocalTime.LocalTime -> [Allowance] -> Bool | ||||
| shouldBeBlocked _ [] = True | ||||
| shouldBeBlocked date allowances = do | ||||
|   case filter (isToday date . day) allowances of | ||||
|     [Allowance{timeslots}] -> | ||||
|       isWithinTimeSlot date timeslots | ||||
|     [] -> False | ||||
|     [Allowance{timeslots}] -> not $ isWithinTimeSlot date timeslots | ||||
|     [] -> True | ||||
|     -- Error when more than one rule per day | ||||
|     _  -> False | ||||
|     _  -> True | ||||
| 
 | ||||
| serializeEntry :: EtcHostEntry -> Text | ||||
| serializeEntry EtcHostEntry{ip, domains} = | ||||
| -- | Maps an EtcHostsEntry to the line of text url-blocker will append to /etc/hosts. | ||||
| serializeEtcHostEntry :: EtcHostsEntry -> Text | ||||
| serializeEtcHostEntry EtcHostsEntry{ip, domains} = | ||||
|   (getIPAddress ip) <> "\t" <> (Text.unwords $ fmap getDomain domains) | ||||
| 
 | ||||
| toEtcHostEntry :: LocalTime.LocalTime -> Rule -> Maybe EtcHostEntry | ||||
| toEtcHostEntry date Rule{urls, allowed} = | ||||
|   if isAllowed date allowed then | ||||
|     Nothing | ||||
|   else | ||||
|     Just $ EtcHostEntry { ip = IPAddress "127.0.0.1" | ||||
| -- | Create an EtcHostsEntry mapping the URLs in `rule` to 127.0.0.1 if the | ||||
| -- URLs should be blocked. | ||||
| maybeBlockURL :: LocalTime.LocalTime -> Rule -> Maybe EtcHostsEntry | ||||
| maybeBlockURL date Rule{urls, allowed} = | ||||
|   if shouldBeBlocked date allowed then | ||||
|     Just $ EtcHostsEntry { ip = IPAddress "127.0.0.1" | ||||
|                         , domains = fmap (Domain . getURL) urls | ||||
|                         } | ||||
|   else | ||||
|     Nothing | ||||
| 
 | ||||
| -- | Read and parse the rules.json file. | ||||
| -- TODO(wpcarro): Properly handle errors for file not found. | ||||
| -- TODO(wpcarro): Properly handle errors for parse failures. | ||||
| -- TODO(wpcarro): How can we resolve the $HOME directory when this is run as | ||||
| -- root? | ||||
| getRules :: IO [Rule] | ||||
| getRules = do | ||||
|   contents <- LazyByteString.readFile "rules.json" | ||||
|   contents <- LazyByteString.readFile "/home/wpcarro/.config/url-blocker/rules.json" | ||||
|   let payload = Aeson.eitherDecode contents | ||||
|   pure $ Either.fromRight [] payload | ||||
| 
 | ||||
| header :: Text | ||||
| header = | ||||
| -- | Informational header added to /etc/hosts before the entries that | ||||
| -- url-blocker adds. | ||||
| urlBlockerHeader :: Text | ||||
| urlBlockerHeader = | ||||
|   Text.unlines [ "################################################################################" | ||||
|                , "# Added by url-blocker" | ||||
|                , "# Added by url-blocker." | ||||
|                , "#" | ||||
|                , "# Warning: url-blocker will remove anything that you add beneath this header." | ||||
|                , "################################################################################" | ||||
|                ] | ||||
| 
 | ||||
| -- | Removes all entries that url-blocker may have added to /etc/hosts. | ||||
| removeURLBlockerEntries :: Text -> Text | ||||
| removeURLBlockerEntries etcHosts = | ||||
|   case Text.breakOn urlBlockerHeader etcHosts of | ||||
|     (etcHosts', _) -> etcHosts' | ||||
| 
 | ||||
| -- | Appends the newly created `entries` to `etcHosts`. | ||||
| addURLBlockerEntries :: Text -> Text -> Text | ||||
| addURLBlockerEntries entries etcHosts = | ||||
|   Text.unlines [ etcHosts | ||||
|                , urlBlockerHeader | ||||
|                , entries | ||||
|                ] | ||||
| 
 | ||||
| -- | This script reads the current /etc/hosts, removes any entries that | ||||
| -- url-blocker may have added in a previous run, and adds new entries to block | ||||
| -- URLs according to the rules.json file. | ||||
| main :: IO () | ||||
| main = do | ||||
|   rules <- getRules | ||||
|   tz <- LocalTime.getCurrentTimeZone | ||||
|   ct <- Clock.getCurrentTime | ||||
|   let date = LocalTime.utcToLocalTime tz ct | ||||
|       etcHosts = Text.unlines . fmap serializeEntry . Maybe.catMaybes $ fmap (toEtcHostEntry date) rules | ||||
|       entries = rules | ||||
|                 |> fmap (maybeBlockURL date) | ||||
|                 |> Maybe.catMaybes | ||||
|                 |> fmap serializeEtcHostEntry | ||||
|                 |> Text.unlines | ||||
|   existingEtcHosts <- TextIO.readFile "/etc/hosts" | ||||
|   TextIO.putStrLn $ existingEtcHosts <> "\n" <> header <> "\n" <> etcHosts | ||||
|   existingEtcHosts | ||||
|     |> removeURLBlockerEntries | ||||
|     |> addURLBlockerEntries entries | ||||
|     |> \x -> writeFile "/etc/hosts" (Text.unpack x) | ||||
							
								
								
									
										47
									
								
								tools/url-blocker/README.md
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										47
									
								
								tools/url-blocker/README.md
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,47 @@ | |||
| # url-blocker | ||||
| 
 | ||||
| `url-blocker` blocks the URLs that you want to block when you want it to block | ||||
| them. | ||||
| 
 | ||||
| Let's say that you don't want to visit Twitter during the work week. Create the | ||||
| file `~/.config/url-blocker/rules.json` with the following contents and | ||||
| `url-blocker` will take care of the rest. | ||||
| 
 | ||||
| ```json | ||||
| # ~/.config/url-blocker/rules.json | ||||
| [ | ||||
|   { | ||||
|     "urls": [ | ||||
|       "twitter.com", | ||||
|       "www.twitter.com", | ||||
|     ], | ||||
|     "allowed": [ | ||||
|       { | ||||
|         "day": "Saturday", | ||||
|         "timeslots": [ | ||||
|           "00:00-11:59" | ||||
|         ] | ||||
|       }, | ||||
|       { | ||||
|         "day": "Sunday", | ||||
|         "timeslots": [ | ||||
|           "00:00-11:59" | ||||
|         ] | ||||
|       } | ||||
|     ] | ||||
|   } | ||||
| ] | ||||
| ``` | ||||
| 
 | ||||
| ## Installation | ||||
| 
 | ||||
| ```shell | ||||
| $ nix-env -iA 'briefcase.tools.url-blocker' | ||||
| ``` | ||||
| 
 | ||||
| ## How does it work? | ||||
| 
 | ||||
| `systemd` is intended to run `url-blocker` once every minute. `url-blocker` will | ||||
| read `/etc/hosts` and map the URLs defined in `rules.json` to `127.0.0.1` when | ||||
| you want them blocked. Because `systemd` run once every minute, `/etc/hosts` | ||||
| should be current to the minute as well. | ||||
							
								
								
									
										37
									
								
								tools/url-blocker/default.nix
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										37
									
								
								tools/url-blocker/default.nix
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,37 @@ | |||
| { ... }: | ||||
| 
 | ||||
| let | ||||
|   pkgs = import <unstable> {}; | ||||
| 
 | ||||
|   ghc = pkgs.haskellPackages.ghcWithPackages (hpkgs: [ | ||||
|     hpkgs.time | ||||
|     hpkgs.aeson | ||||
|     hpkgs.either | ||||
|   ]); | ||||
| 
 | ||||
|   # This is the systemd service unit | ||||
|   service = pkgs.stdenv.mkDerivation { | ||||
|     name = "url-blocker"; | ||||
|     src = ./.; | ||||
|     buildInputs = with pkgs; [ | ||||
|     ]; | ||||
|     buildPhase = '' | ||||
|     ${ghc}/bin/ghc Main.hs | ||||
|   ''; | ||||
|     installPhase = '' | ||||
|     mv ./Main $out | ||||
|   ''; | ||||
|   }; | ||||
| 
 | ||||
|   # This is the systemd timer unit. | ||||
|   # Run once every minute. | ||||
|   # Give root privilege. | ||||
|   systemdUnit = { | ||||
|     systemd = { | ||||
|       timers.simple-timer = { | ||||
|         wantedBy = [ "timers.target" ]; | ||||
|         partOf = []; | ||||
|       }; | ||||
|     }; | ||||
|   }; | ||||
| in null | ||||
							
								
								
									
										28
									
								
								tools/url-blocker/rules.json
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										28
									
								
								tools/url-blocker/rules.json
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,28 @@ | |||
| [ | ||||
|   { | ||||
|     "urls": [ | ||||
|       "facebook.com", | ||||
|       "www.facebook.com", | ||||
|       "twitter.com", | ||||
|       "www.twitter.com", | ||||
|       "youtube.com", | ||||
|       "www.youtube.com", | ||||
|       "instagram.com", | ||||
|       "www.instagram.com" | ||||
|     ], | ||||
|     "allowed": [] | ||||
|   }, | ||||
|   { | ||||
|     "urls": [ | ||||
|       "chat.googleplex.com" | ||||
|     ], | ||||
|     "allowed": [ | ||||
|       { | ||||
|         "day": "Sunday", | ||||
|         "timeslots": [ | ||||
|           "18:35-18:39" | ||||
|         ] | ||||
|       } | ||||
|     ] | ||||
|   } | ||||
| ] | ||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue