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…
Reference in a new issue