spacecookie 0.2.1.2 → 1.0.0.0
raw patch · 34 files changed
+2604/−587 lines, 34 filesdep +asyncdep +download-curldep +filepath-bytestringdep −filepathdep ~aesondep ~attoparsecdep ~base
Dependencies added: async, download-curl, filepath-bytestring, process, tasty, tasty-expected-failure, tasty-hunit, text
Dependencies removed: filepath
Dependency ranges changed: aeson, attoparsec, base, bytestring, containers, directory, fast-logger, hxt-unicode, mtl, socket, transformers, unix
Files
- CHANGELOG.md +245/−0
- README.md +71/−62
- docs/gophermap +0/−14
- docs/gophermap-pygopherd.txt +0/−45
- docs/man/spacecookie.1 +170/−0
- docs/man/spacecookie.gophermap.5 +156/−0
- docs/man/spacecookie.json.5 +268/−0
- etc/spacecookie.json +11/−2
- server/Config.hs +0/−43
- server/Main.hs +184/−107
- server/Network/Spacecookie/Config.hs +84/−0
- server/Network/Spacecookie/FileType.hs +105/−0
- server/Network/Spacecookie/Systemd.hs +95/−0
- server/Systemd.hs +0/−59
- spacecookie.cabal +70/−37
- src/Network/Gopher.hs +313/−142
- src/Network/Gopher/Log.hs +168/−0
- src/Network/Gopher/Types.hs +9/−12
- src/Network/Gopher/Util.hs +48/−11
- src/Network/Gopher/Util/Gophermap.hs +67/−53
- src/Network/Gopher/Util/Socket.hs +60/−0
- test/Main.hs +20/−0
- test/Test/FileTypeDetection.hs +59/−0
- test/Test/Gophermap.hs +100/−0
- test/Test/Integration.hs +139/−0
- test/data/bucktooth.gophermap +95/−0
- test/data/pygopherd.gophermap +14/−0
- test/integration/root/.gophermap +6/−0
- test/integration/root/dir/.hidden +0/−0
- test/integration/root/dir/another/.git-hello +0/−0
- test/integration/root/dir/macintosh.hqx +0/−0
- test/integration/root/dir/mystery-file +0/−0
- test/integration/root/plain.txt +35/−0
- test/integration/spacecookie.json +12/−0
CHANGELOG.md view
@@ -1,11 +1,250 @@ # Revision history for spacecookie +## 1.0.0.0++2021-03-16++TL;DR:++* For server users, new features and configuration options have been+ added, but old configuration stays compatible. However some gophermap+ files may need adjusting, especially if they contain absolute paths+ not starting with a slash.+* For library users there are multiple braking changes to the core API+ that probably need adjusting in downstream usage as well as some+ changes to behavior.++### Server and Library Users++#### Gophermap parsing++There have been quite a few, partly breaking changes to gophermap parsing in+the library in an effort to fully support the format used in pygopherd and+bucktooth. Instances where spacecookie's parsing deviated from the established+format have been resolved and we now ship a test suite which checks compliance+against sample files from bucktooth and pygopherd.++We now support relative paths correctly: If a selector in a gophermap doesn't+start with `/` or `URL:` it is interpreted as a relative path and prefixed+with the directory the gophermap is located in. This should make writing+gophermaps much more convenient, as it isn't necessary to enter absolute+selectors anymore. However, absolute selectors not starting with `/`+are **broken** by this.++To facilitate these changes, the API of `Network.Gopher.Util.Gophermap`+changed in the following way:++* `GophermapEntry` changed to use `GophermapFilePath` instead of `FilePath`+ which may either be `GophermapAbsolute`, `GophermapRelative` or `GophermapUrl`.+ Additionally, `GophermapFilePath` is a wrapper around `RawFilePath`, contrary+ to the previous use of `FilePath`.+* `gophermapToDirectoryResponse` takes an additional parameter describing+ the directory the gophermap is located in to resolve relative to absolute+ selectors.++See also [#22](https://github.com/sternenseemann/spacecookie/issues/22) and+[#23](https://github.com/sternenseemann/spacecookie/pull/23).++Menu lines which only contain a file type and name are now required to be+terminated by a tab before the newline. This also reflects the behavior+of bucktooth and pygopherd (although the latter's documentation on this+is a bit misleading). Although this **breaks** entries like `0/file`,+info lines which start with a valid file type character like+`1. foo bar baz` no longer get mistaken for normal menu entries.+See [#34](https://github.com/sternenseemann/spacecookie/pull/34).++The remaining, less significant changes are:++* Fixed parsing of gophermap files whose last line isn't terminated+ by a newline.+* The `gophermaplineWithoutFileTypeChar` line type which mapped menu entries+ with incompatible file type characters to info lines has been removed. Such+ lines now result in a parse error. This is a **breaking change** if you+ relied on this behavior.+* `parseGophermap` now consumes the end of input.++#### Changes to Connection Handling++* We now wait up to 1 second for the client to close the connection on+ their side after sending all data. This fixes an issue specific to+ `curl` which would result in it failing with a recv error (exit code+ 56) randomly.+ See also [#42](https://github.com/sternenseemann/spacecookie/issues/42)+ and [#44](https://github.com/sternenseemann/spacecookie/pull/44).+* Requests from clients are now checked more vigorously and limited+ in size and time to prevent denial of service attacks.+ * Requests may not exceed 1MB in size+ * The client is only given 10s to send its request+ * After the `\r\n` no additional data may be sent++### Server Users++#### Configuration++* Add new `listen` field to configuration allowing to specify the+ listening address and port. It expects an object with the fields+ `port` and `addr`. The top level `port` option has been *deprecated*+ as a result. It is now possible to bind to the link local address+ `::1` only without listening on public addresses.+ See [#13](https://github.com/sternenseemann/spacecookie/issues/13) and+ [#19](https://github.com/sternenseemann/spacecookie/pull/19).+* Log output is now configurable via the new `log` field in the+ configuration. Like `listen` it expects an object which supports the+ following fields.+ See [#10](https://github.com/sternenseemann/spacecookie/issues/10) and+ [#20](https://github.com/sternenseemann/spacecookie/pull/20).+ * `enable` allows to enable and disable logging+ * `hide-ips` can be used to hide private information of users from+ log output. This is *now enabled by default*.+ * `hide-time` allows to hide timestamps if your log setup already+ takes care of that.+ * `level` allows to switch between `error` and `info` log level.+* Make `port` and `listen` → `port` settings optional, defaulting to 70.++Config parsing should be backwards compatible. Please open a bug report if+you experience any problems with that or any constellation of the new+settings.++#### Other changes++* A not allowed error is now generated if there are any dot directories or+ dot files along the path: `/foo/.dot/bar` would now generate an error+ instead of being processed like before.+* GHC RTS options are now enabled and the default option `-I10` is passed to+ spacecookie.+* Exit if dropping privileges fails instead of just logging an error like before.+ See [#45](https://github.com/sternenseemann/spacecookie/pull/45).+* Expand user documentation by adding three man pages+ ([rendered](https://sternenseemann.github.io/spacecookie/)) on the server daemon:+ * `spacecookie(1)`: daemon invocation and behavior+ * `spacecookie.json(5)`: daemon configuration+ * `spacecookie.gophermap(5)`: gophermap format documentation+* Fix the file not found error message erroneously stating that access of that+ file was not permitted.+* Clarify error message when an URL: selector is sent to spacecookie.+* Print version when `--version` is given+* Print simple usage instructions when `--help` is given or the command line+ can't be parsed.+* A warning is now logged when a gophermap file doesn't parse and the standard+ directory response is used as fallback.++### Library Users++### New Representation of Request and Response++The following changes are the most significant to the library as they+break virtually all downstream usage of spacecookie as a library.++The gopher request handler for the `runGopher`-variants now receives+a `GopherRequest` record representing the request instead of the+selector as a `String`. The upsides of this are as follows:++* Handlers now know the IPv6 address of the client in question+* Simple support for search transaction is introduced as the request+ sent by the client is split into selector and search string.+* Selectors are no longer required to be UTF-8 as `ByteString` is used.++If you want to reuse old handlers with minimal adjustments you can+use a snippet like the following. Note though that you might have+to make additional adjustments due to the changes to responses.++ wrapLegacyHandler :: (String -> GopherResponse)+ -> (GopherRequest -> GopherResponse)+ wrapLegacyHandler f = f . uDecode . requestSelectorRaw++Corresponding to the switch to `ByteString` in `GopherRequest` the+whole API now uses `ByteString` to represent paths and selectors.+This prompts the following additional, breaking changes:++* `ErrorResponse` now uses a `ByteString` instead of a `String`.+* `GopherMenuItem`'s `Item` now uses a `ByteString` instead of a `FilePath`+ (you can use `encodeFilePath` from `filepath-bytestring` to fix downstream+ usage).+* `sanitizePath` and `sanitizeIfNotUrl` now operate on `RawFilePath`s+ (which is an alias for `ByteString`).+* As already mentioned, the gophermap API uses `RawFilePath`s instead+ of `FilePath`s as well.++See also [#38](https://github.com/sternenseemann/spacecookie/pull/38)+and [#26](https://github.com/sternenseemann/spacecookie/issues/26).++#### Logging++The built-in logging support has been removed in favor of a log handler the+user can specify in `GopherConfig`. This is a **breaking change** in two ways:++* The type of `GopherConfig` changed as it has a new field called+ `cLogHandler`.+* By default (`defaultGopherConfig`) the spacecookie library no longer+ has logging enabled.++The motivation for this was to enable the library user to influence the log+output more. More specifically the following abilities were to be made+possible for the bundled server daemon:++* It should be possible to hide timestamps in the log output: If you are+ using systemd for example, the journal will take care of those.+* There should be the ability to hide sensitive information from the log+ output: Unless necessary client IP addresses shouldn't be logged to+ disk.+* The log output should be filterable by log level.+* It should be easy for server implementation to also output log messages+ via the same system as the `spacecookie` library.++The best solution to guarantee these properties (and virtually any you could+want) is to let the library user implement logging. This allows any target+output, any kind of logging, any kind of clock interaction to generate+timestamps (or not) etc. This is why the spacecookie library no longer+implements logging. Instead it lets you configure a `GopherLogHandler`+which may also be used by the user application (it is a simple `IO`+action). This additionally scales well: In the simplest case this could+be a trivial wrapper around `putStrLn`.++The second part to the solution is `GopherLogStr` which is the string type+given to the handler. Internally this is currently implemented as a `Seq`+containing chunks of `Builder`s which are coupled with meta data. This+should allow decent performance in building and rendering of `GopherLogStr`s.+The latter of which is relatively convenient using `FromGopherLogStr`.++The tagged chunks are used to allow a clean implementation of hiding sensitive+data: `makeSensitive` can be used to tag all chunks of a `GopherLogStr` which+will then be picked up by `hideSensitive` which replaces all those chunks+with `[redacted]`. This way sensitive information can be contained inline in+strings and users can choose at any given point whether it should remain there+or be hidden.++The new logging mechanism was implemented in+[#29](https://github.com/sternenseemann/spacecookie/pull/29).++Previously it was attempted to make built-in logging more configurable+(see [#13](https://github.com/sternenseemann/spacecookie/issues/13) and+[#19](https://github.com/sternenseemann/spacecookie/pull/19)), but this+was overly complicated and not as flexible as the new solution. Therefore+it was scrapped in favor of the new system.++#### Other Changes++* `cRunUserName` has been removed from `GopherConfig` since the functionality+ doesn't need special treatment as users can implement it easily via the+ ready action of `runGopherManual`. The formerly internal `dropPrivileges`+ function is now available via `Network.Gopher.Util` to be used for this+ purpose. See [#45](https://github.com/sternenseemann/spacecookie/pull/45).+ This is a **breaking change** and requires adjustment if you used the built+ in privilege deescalation capabilities.+* `santinizePath` and `santinizeIfNotUrl` have been corrected to `sanitizePath`+ and `sanitizeIfNotUrl` respectively. This is a **breaking change** to the+ interface of `Network.Gopher.Util`.+ ## 0.2.1.2 Bump fast-logger +2020-05-23+ * Bump fast-logger dependency, fix build ## 0.2.1.1 Fixed Privilege Dropping +2019-12-10+ * Server * Make `user` parameter in config optional. If it is not given or set to `null`, `spacecookie` won't attempt to change its UID and GID. This is especially useful, if socket activation is used. In that case it is not@@ -22,6 +261,8 @@ ## 0.2.1.0 Systemd Support +2019-10-20+ * Improved systemd support. * Support for the notify service type * Support for socket activation and socket (fd) storage@@ -32,9 +273,13 @@ ## 0.2.0.1 Hackage release +2019-05-23+ Fixed a problem hindering the hackage release. ## 0.2.0.0 initial release++2019-05-23 * First version. Released on an unsuspecting world. Includes: * Library for writing any gopher server / application.
README.md view
@@ -1,43 +1,48 @@- ____ _ _- / ___| _ __ __ _ ___ ___ ___ ___ ___ | | _(_) ___- \___ \| '_ \ / _` |/ __/ _ \/ __/ _ \ / _ \| |/ / |/ _ \- ___) | |_) | (_| | (_| __/ (_| (_) | (_) | <| | __/- |____/| .__/ \__,_|\___\___|\___\___/ \___/|_|\_\_|\___|- |_| – haskell gopher server+# spacecookie -## What is Gopher?+Haskell gopher server daemon and library. -> The Gopher protocol /ˈɡoʊfər/ is a TCP/IP application layer protocol designed for distributing, searching, and retrieving documents over the Internet. The Gopher protocol was strongly oriented towards a menu-document design and presented an alternative to the World Wide Web in its early stages, but ultimately HTTP became the dominant protocol. The Gopher ecosystem is often regarded as the effective predecessor of the World Wide Web.+## Features -– [WP](https://en.wikipedia.org/wiki/Gopher_(protocol))+* implements RFC1436+* optionally supports common protocol extensions:+ * informational entries via the `i`-type+ * [`h`-type and URL entries](http://gopher.quux.org:70/Archives/Mailing%20Lists/gopher/gopher.2002-02%7C/MBOX-MESSAGE/34)+* supports gophermaps (see [below](#adding-content))+* supports systemd socket activation+* provides a library for custom gopher applications ([see documentation](http://hackage.haskell.org/package/spacecookie/docs/Network-Gopher.html)) -## What is Spacecookie?+## Non-Features -Spacecookie is a gopher server and…+spacecookie intentionally does not support: -* is RFC1436-compliant-* supports info-line in menus (compatible protocol extension)-* supports gophermaps (see [below](#adding-content))-* provides a library for custom gopher applications ([see documentation](http://hackage.haskell.org/package/spacecookie/docs/Network-Gopher.html))-* can integrate with systemd using socket activation+* HTTP, Gemini: Multi protocol support is a non-goal for spacecookie.+ For HTTP you can [proxy](https://github.com/sternenseemann/gopher-proxy)+ pretty easily, however.+* Search: Gopher supports search transactions, but the spacecookie daemon doesn't offer+ the possibility to add a search engine to a gopherspace. It is however+ entirely possible to implement an index search server using [the+ spacecookie library](https://hackage.haskell.org/package/spacecookie/docs/Network-Gopher.html) ## Installation -* Nix(OS): [`pkgs.haskellPackages.spacecookie`](https://nixos.org/nixos/packages.html?channel=nixos-unstable&query=spacecookie) (see also [below](#on-nixos))-* Cabal: `cabal v2-install spacecookie` (see also [hackage package](http://hackage.haskell.org/package/spacecookie))--[Nix](https://nixos.org/nix/) is probably the most hassle-free way to install spacecookie at the moment.+* Nix(OS): [`pkgs.haskellPackages.spacecookie`](https://search.nixos.org/packages?channel=unstable&from=0&size=50&sort=relevance&query=spacecookie)+ (see also [below](#on-nixos))+* Cabal: `cabal v2-install spacecookie`+ (see also [hackage package](http://hackage.haskell.org/package/spacecookie)) -## Configuration+## Documentation -In order to run your new gopher server, you have to configure it first. You can find an example configuration file in `./etc/spacecookie.json`. JSON is mostly used due to legacy reason, it's not ideal, but alright for such a small configuration file.+* User Documentation: [spacecookie(1)](https://sternenseemann.github.io/spacecookie/spacecookie.1.html)+* [Developer Documentation](https://hackage.haskell.org/package/spacecookie) -Let's have a quick look at the options:+## Configuration -* `hostname`: The hostname your spacecookie will be reachable through. This should be accurate as gopher clients use it for their subsequent requests.-* `user`: The user that is used to run spacecookie. If given, spacecookie will switch to this user after setting up its socket. Can be omitted or set to `null`, if root privileges are not needed (e. g. if systemd socket activation or a non well-known port is used).-* `port`: The port spacecookie should listen on. The well-known port for gopher is 70.-* `root`: The directory which the files to serve via gopher are located in.+spacecookie is configured via a JSON configuration file.+All available options are documented in+[spacecookie.json(5)](https://sternenseemann.github.io/spacecookie/spacecookie.json.5.html).+This repository also contains an example configuration file in+[`etc/spacecookie.json`](./etc/spacecookie.json). ## Running @@ -45,11 +50,13 @@ spacecookie /path/to/spacecookie.json -Spacecookie runs as a simple process and doesn't fork or write a PID file. Therefore it is very simple to use a supervisor to run it as a proper daemon. +spacecookie runs as a simple process and doesn't fork or write a PID file.+Therefore any supervisor (systemd, daemontools, ...) can be used to run+it as a daemon. ### With systemd -Spacecookie supports systemd socket activation. To set it up you'll need+spacecookie supports systemd socket activation. To set it up you'll need to install `spacecookie.service` and `spacecookie.socket` like so: cp ./etc/spacecookie.{service,socket} /etc/systemd/system/@@ -60,27 +67,31 @@ Of course make sure that all the used paths are correct! -### Without systemd--Spacecookie does not require systemd nor depend on it. Since socket activation only uses an environment variable and a type unix socket, it is very lightweight and can be utilized without using a systemd library or dbus.--For example, it should be pretty easy to write a [runit](http://smarden.org/runit/) service file.+How the systemd integration works is explained in+[spacecookie(1)](https://sternenseemann.github.io/spacecookie/spacecookie.1.html#SYSTEMD_INTEGRATION). ### On NixOS -On [NixOS](https://nixos.org/nixos/) it is best to use the service module [`services.spacecookie`](https://github.com/NixOS/nixpkgs/blob/master/nixos/modules/services/networking/spacecookie.nix). Setting up Spacecookie is as simple as adding the following lines to your `configuration.nix`:+[NixOS](https://nixos.org/nixos/) provides a service module for spacecookie:+[`services.spacecookie`](https://github.com/NixOS/nixpkgs/blob/master/nixos/modules/services/networking/spacecookie.nix).+Setting up spacecookie is as simple as adding the following line to your `configuration.nix`: services.spacecookie.enable = true;- services.spacecookie.hostname = "localhost"; -Of course you should replace `localhost` with the domain name or IP address your server is reachable through. Additionally you can specify the directory from which Spacecookie serves content using `services.spacecookie.root`, default is `/srv/gopher`.+For all available options, refer to the NixOS manual: +* [NixOS stable](https://nixos.org/manual/nixos/stable/options.html#opt-services.spacecookie.enable)+* [NixOS unstable](https://nixos.org/manual/nixos/unstable/options.html#opt-services.spacecookie.enable)+ ## Adding Content -Spacecookie acts as a simple file server, only excluding files that start with a dot.-It generates gopher menus automatically; however you can use custom ones by adding a gophermap file.+spacecookie acts as a simple file server, only excluding files+or directories that start with a dot. It generates gopher menus+automatically, but you can also use custom ones by adding a+gophermap file. -Spacecookie checks for `.gophermap` in every directory it serves and, if present, uses the menu specified in there.+spacecookie checks for `.gophermap` in every directory it serves and,+if present, uses the menu specified in there. Such a file looks like this: @@ -90,34 +101,32 @@ also possible. 1Menu Entry for a directory full of funny stuff /funny- iFunny Image /funy.jpg+ IFunny Image /funny.jpg gcat gif /cat.gif 0about me /about.txt 1Floodgap's gopher server / gopher.floodgap.com 70 -So what does that all mean? These are the rules for a gophermap file:--* comment lines (called info lines in spacecookie's code) are just lines of text. They must not contain a tab! They will be displayed as lines of text by the gopher client.-* menu entries for files or directories start with a single char which specifies the file type, followed by the text for that file without a space or tab between them! Then the path is added after a tab.-* "Links" to other servers are like file/directory menu entries but the server's hostname and its port must be added (tab-separated).+As you can see, it largely works like the actual gopher menu a server will+send to clients, but allows to omit redundant information and to insert+lines that are purely informational and not associated with a file.+[spacecookie.gophermap(5)](https://sternenseemann.github.io/spacecookie/spacecookie.gophermap.5.html)+explains syntax and semantics in more detail. -The file type characters are defined in [RFC1436](https://tools.ietf.org/html/rfc1436#page-10). Detailed documentation on the gophermap format [can be found here](./docs/gophermap-pygopherd.txt).+The format is compatible with the ones supported by+[Bucktooth](gopher://gopher.floodgap.com/1/buck/) and+[pygopherd](https://github.com/jgoerzen/pygopherd).+If you notice any incompatibilities, please open an issue. ## Portability -Spacecookie's portability is mostly limited by [haskell-socket](https://github.com/lpeterse/haskell-socket).-`haskell-socket` should work on any POSIX-compliant Operating system, so Spacecookie should support those-platforms as well.--However I personally have only tested Spacecookie on GNU/Linux (with and without systemd) so far. Feel free to send me an email or generate a [build report](http://hackage.haskell.org/package/spacecookie/reports/)-if you've built spacecookie (or failed to do so) on another platform!--Windows is currently not supported as we use some Unix-specific features, but there is probably-little demand for it as well.--## HTTP Support?+spacecookie is regularly tested on GNU/Linux via CI, but+should also work on other Unix-like operating systems.+Most portability problems arise due to+[haskell-socket](https://github.com/lpeterse/haskell-socket)+which is for example known+[not to work on OpenBSD](https://github.com/lpeterse/haskell-socket/issues/63). -Spacecookie will never support HTTP to keep the code simple and clean. You can-however use an HTTP to Gopher Proxy with Spacecookie just fine. Any proxy-supporting RFC1436 should work, my own [gopher-proxy](https://github.com/sternenseemann/gopher-proxy)-might work for you.+Windows support would be possible, but could be tricky as gopher+expects Unix-style directory separators in paths. I personally+don't want to invest time into it, but would accept patches adding+Windows support.
− docs/gophermap
@@ -1,14 +0,0 @@-Welcome to Pygopherd! You can place your documents-in /var/gopher for future use. You can remove the gophermap-file there to get rid of this message, or you can edit it to-use other things. (You'll need to do at least one of these-two things in order to get your own data to show up!)--Some links to get you started:--1Pygopherd Home /devel/gopher/pygopherd gopher.quux.org 70-1Quux.Org Mega Server / gopher.quux.org 70-1The Gopher Project /Software/Gopher gopher.quux.org 70-1Traditional UMN Home Gopher / gopher.tc.umn.edu 70--Welcome to the world of Gopher and enjoy!
− docs/gophermap-pygopherd.txt
@@ -1,45 +0,0 @@-GOPHERMAP FILE DOCUMENTATION FROM THE PYGOPHERD MAN PAGE-- The gophermap files contain two types of lines, which are described- here using the same convention normally used for command line argu-- ments. In this section, the symbol \t will be used to indicate a tab- character, Control-I.-- full line of informational text--- gophertypeDESCRIPTION [ \tselector [ \thost [ \tport ] ] ]--- Note: spaces shown above are for clarity only and should not actually- be present in your file.-- The informational text must not contain any tab characters, but may- contain spaces. Informational text will be rendered with gopher type- i, which will cause it to be displayed on a client's screen at its par-- ticular position in the file.-- The second type of line represents a link to a file or directory. It- begins with a single-character Gopher type (see Gopher Item Types- below) followed immediately by a description and a tab character.- There is no space or other separator between the gopher type and the- description. The description may contain spaces but not tabs.-- The remaining arguments are optional, but only to the extent that argu-- ments may be omitted only if all arguments after them are also omitted.- These arguments are:-- selector- The selector is the name of the file on the server. If it- begins with a slash, it is an absolute path; otherwise, it is- interpreted relative to the directory that the gophermap file is- in. If no selector is specified, the description is also used- as the selector.-- host The host specifies the host on which this resource is located.- If not specified, defaults to the current server.-- port The port specifies the port on which the resource is located.- If not specified, defaults to the port the current server is- listening on.-
+ docs/man/spacecookie.1 view
@@ -0,0 +1,170 @@+.Dd $Mdocdate$+.Dt SPACECOOKIE 1+.Os+.Sh NAME+.Nm spacecookie+.Nd gopher server daemon+.Sh SYNOPSIS+.Nm+.Op Fl -version+.Ar config.json+.Sh DESCRIPTION+.Nm+is a simple to use gopher daemon for serving static files.+It is either invoked with the+.Fl -version+flag to print its version or with the path to its config file+as the single argument.+The minimal config file needs to tell+.Nm+about the directory to serve and the server's name, i. e. the hostname+or IP address the server is reachable through.+All configuration options, the format and default values are explained in+.Xr spacecookie.json 5 .+.Pp+On startup,+.Nm+will check if it has been started with systemd socket activation.+If that's true, it will use the socket passed from systemd, if not,+it will setup the socket itself.+After that it will call+.Xr setuid 2+to switch to a less privileged user if configured to do so and start+accepting incoming gopher requests on the socket.+Note that using socket activation eliminates the need for starting+as a privileged user in the first place because systemd will take+care of the socket.+The systemd integration is explained in more detail in its own section.+.Pp+.Nm+will not fork itself to the background or otherwise daemonize+which can, however, be achieved using a supervisor.+Logs are always written to+.Sy stderr+and can be collected and rotated by another daemon or tool if desired.+.Pp+Incoming requests are filtered: No files or directories outside+the served directory or that start with a dot may be accessed by clients.+Allowed files are returned to clients unfiltered. For directories,+.Nm+checks if they contain a+.Ql .gophermap+file: If they contain one, it is used to generate the directory response,+otherwise one is generated automatically which involves guessing all file+types from file extensions.+The default file type is+.Ql 0 ,+text file.+The file format of the+.Ql gophermap+files and its use are explained in+.Xr spacecookie.gophermap 5 .+.Sh SYSTEMD INTEGRATION+.Nm+optionally supports two systemd-specific features:+It acts as a+.Sy notify+type service and supports socket activation.+.Pp+If you are writing a+.Xr systemd.service 5+file, be sure to use the+.Ql Type=notify+directive which allows+.Nm+to tell systemd when it has finished starting up and+when it is stopping before actually exiting.+.Pp+For socket activation, create a+.Xr systemd.socket 5+file that starts the+.Nm+service.+This has several advantages: For one, it allows starting+.Nm+on demand only and reducing the load on server startup.+Additionally it means that the daemon doesn't ever need+to be started as root because it won't need to setup a+socket bound to a well-known port.+.Pp+Mind the following points when configuring socket activation:+.Bl -bullet+.It+The port set in the+.Xr systemd.socket 5+file must match the port configured in+.Xr spacecookie.json 5 .+.It+The socket set up by+.Xr systemd 1+must use the IPv6 address family and the TCP protocol.+It is recommended to always set+.Ql BindIPv6Only=both+in+.Xr systemd.socket 5 .+To listen on an IPv4 address only, you can use an IPv6 socket+with a mapped IPv4 address.+.It+As always the+.Sy hostname+setting must match the public address or hostname the socket is listening on.+.El+.Pp+Make sure to check your socket configuration settings carefully since+.Nm+doesn't run any sanity checks on the socket received from+.Xr systemd 1+yet.+.Pp+An example+.Xr systemd.service 5+and+.Xr systemd.socket 5+file are provided in the+.Nm+source distribution in the+.Ql etc+directory.+.Sh SEE ALSO+.Xr spacecookie.json 5 ,+.Xr spacecookie.gophermap 5 ,+.Xr systemd.service 5+and+.Xr systemd.socket 5 .+.Pp+For writing custom gopher application using the spacecookie library refer to the+.Lk https://hackage.haskell.org/package/spacecookie API documentation .+.Sh STANDARDS+By default,+.Nm+always behaves like a gopher server as described in+.Lk https://tools.ietf.org/html/rfc1436 RFC1436 .+However users can configure+.Nm+to utilize common protocol extensions like the+.Ql h+and+.Ql i+types and+.Lk http://gopher.quux.org:70/Archives/Mailing%20Lists/gopher/gopher.2002-02%7C/MBOX-MESSAGE/34 URLs to other protocols .+.Sh AUTHORS+.Nm+has been written and documented by+.An sternenseemann ,+.Mt sterni-spacecookie@systemli.org .+.Sh SECURITY CONSIDERATIONS+.Nm+supports no migitations or attack surface reduction measures other than+automatically switching to a less privileged user after binding.+It is recommended to use this feature and to make use of containering+or sandboxing like for example+.Xr systemd.exec 5+supports.+.Pp+TLS-enabled gopher, like the+.Ql gophers+protocol supported by+.Xr curl 1+is not natively supported by+.Nm+at this time.
+ docs/man/spacecookie.gophermap.5 view
@@ -0,0 +1,156 @@+.Dd $Mdocdate$+.Dt SPACECOOKIE.GOPHERMAP 5+.Os+.Sh NAME+.Nm spacecookie.gophermap+.Nd gophermap file format supported by+.Xr spacecookie 1+.Sh DESCRIPTION+A gophermap file allows to describe a gopher menu without the need to include redundant information.+The format supported by+.Xr spacecookie 1+has originally been introduced by Bucktooth and is supported by most popular gopher server daemons like for example+.Xr pygopherd 8 .+.Pp+A gophermap file stored as+.Ql .gophermap+in a directory under the gopher root of+.Xr spacecookie 1+is parsed and used as a gopher menu instead of the automatically generated default variant.+This allows users to customize the directory listings by specifying informational text,+links to files, (other) directories, gopher servers or protocols themselves.+.Sh FORMAT+The format is plain text and line based. Both Unix and DOS style line endings are allowed.+.Xr spacecookie 1+distinguishes between two types of lines:+.Bl -tag -width 4n+.It Sy info lines+Info lines are lines of text in a gophermap which don't have any special+format requirements except that they may not contain any tab characters.+.Pp+.Dl Any text which may contain anything but tabs.+.Pp+They are also rendered als plain text without any associated links to gopher+clients which support them. Info lines are technically not part of the gopher+protocol nor mentioned in RFC1436, but this protocol extension is+widely supported and used.+.Pp+The usual purpose is to display additional text, headings and decorative elements+which are not directly related to other resources served via gopher:+.Bd -literal -offset indent++------------------------------++| Welcome to my Gopher Server! |++------------------------------+++Below you can find a collection of files I deemed+interesting or useful enough to publish them.+.Ed+.Pp+Empty lines are interpreted as info lines which have no content.+.It Sy menu entries+Lines describing menu entries are of the following form.+All spaces are for readability only and must not be present in the actual format.+Everything in brackets may be omitted, the semantics of which are explained below.+.Pp+.Dl gopherfiletypeNAME\\\\t Op SELECTOR Op \\\\tSERVER Op \\\\tPORT+.Bl -tag -width 1n+.It Em gopherfiletype+File type character indicating the file type of the linked resource to the client.+See+.Lk https://tools.ietf.org/html/rfc1436#page-14 RFC1436+for a list of valid file types.+Additionally,+.Xr spacecookie 1+supports+.Ql i+which indicates an info line and+.Ql h+which indicates an HTML document.+.It Em NAME+Name of the linked resource which will show up as the text of the menu entry.+May contain any characters except newlines and tabs.+.Em NAME+must always be terminated by a tab.+.It Em SELECTOR+Gopher selector the entry should link to.+Same restrictions in terms of characters apply as for+.Em NAME ,+but there should only be a tab character afterwards if another field is specified.+If it is omitted, the value of+.Em NAME+is used.+If the+.Em SELECTOR+starts with+.Ql / ,+it is interpreted as an absolute path and given to the client as-is.+If it starts with+.Ql URL: ,+it is assumed that it is a link to another protocol and passed to the+client without modification (see below). In all other cases,+it is assumed that the selector is a relative path and is converted to+an absolute path before serving the menu to a client.+.Pp+You can read more about+.Ql URL:+links which are another common gopher protocol extension in+.Lk http://gopher.quux.org:70/Archives/Mailing%20Lists/gopher/gopher.2002-02%7C/MBOX-MESSAGE/34 this email from John Goerzen.+.It Em SERVER+Describes the server+.Em SELECTOR+should be retrieved from.+Same character restrictions apply and it must come after a tab character as well.+If it is omitted, the hostname of the server generating the menu is used.+.It Em PORT+Describes the port+.Em SERVER+is running on.+Must come after a tab and is terminated by the end of the line or file.+If this field is left out, the server generating the menu uses its own port.+.El+.El++A gophermap file may contain any number of menu and info lines.+They are then converted to actual gopher protocol menu entries clients+understand line by line as described above.+.Sh EXAMPLE+Tabs are marked with+.Ql ^I+for clarity.+.Bd -literal -offset indent+spacecookie+===========++Welcome to spacecookie's gopher page!++Get a copy either by downloading the latest+stable release or cloning the development version:++hGitHub page^I URL:https://github.com/sternenseemann/spacecookie/+9latest tarball^I /software/releases/spacecookie-0.3.0.0.tar.gz++The following documentation resources should get you started:++0README^I README.md+1man pages^I manpages/++Other gopher server daemons (the first link only works+if this server is running on port 70):++1pygopherd^I /devel/gopher/pygopherd^I gopher.quux.org+1Bucktooth^I /buck^I gopher.floodgap.com^I 70+.El+.Sh SEE ALSO+.Xr pygopherd 8 ,+.Lk gopher://gopher.floodgap.com/0/buck/dbrowse?faquse%201a Bucktooth's gophermap documentation+and+.Lk https://tools.ietf.org/html/rfc1436#page-14 the file type list from RFC1436 .+.Pp+.Xr spacecookie 1 ,+.Xr spacecookie.json 5+.Sh AUTHORS+The+.Nm+documentation has been written by+.An sternenseemann ,+.Mt sterni-spacecookie@systemli.org .
+ docs/man/spacecookie.json.5 view
@@ -0,0 +1,268 @@+.Dd $Mdocdate$+.Dt SPACECOOKIE.JSON 5+.Os+.Sh NAME+.Nm spacecookie.json+.Nd configuration file for+.Xr spacecookie 1+.Sh DESCRIPTION+The+.Xr spacecookie 1+config file is a JSON file which contains a single object.+The allowed fields representing individual settings and their effect are explained below.+.Ss REQUIRED SETTINGS+The following settings must be part of every configuration file as there+is no default or fallback value for them.+.Bl -tag -width 2n -offset 0n+.It Sy hostname+Describes the public server name+.Xr spacecookie 1+is reachable through, i. e. the address clients will use to connect to it.+It will be used to populate gopher menus with the correct server name, so+follow up requests from clients actually reach the correct server.+For testing purposes, it can be useful to set it to+.Ql localhost .+.Pp+Type: string.+.It Sy root+Sets the the directory+.Xr spacecookie 1+should serve via gopher.+All gopher requests will be resolved to files or directories under that root.+Files and directories will be served to users if no component of the resolved+path starts with a dot and they are readable for the user+.Xr spacecookie 1+is running as.+.Pp+Type: string.+.El+.Ss OPTIONAL SETTINGS+The following settings are optional, meaning there is either a default value+or an obvious default behavior if they are not given.+.Bl -tag -width 2n -offset 0n+.It Sy listen+Describes the address and port+.Xr spacecookie 1+should listen on.+Both aspects can be controlled individually by the two optional fields+described below.+.Pp+Type: object.+.Bl -tag -offset 0n -width 2n+.It Sy port+Port to listen on.+The well-known port for gopher is+.Ms 70 .+.Pp+If+.Xr systemd.socket 5+activation is used, this setting will have no effect on the actual+port the socket is bound to since this is done by+.Xr systemd 1 .+It will then only be used to display the server's port in gopher menus for+subsequent requests, so make sure whatever is set here matches what+.Xr systemd 1+is doing.+.Pp+Type: number.+Default:+.Ql 70 .+.It Sy addr+Address to listen and accept gopher requests on.+In contrast to+.Sy hostname ,+this option controls the socket setup and not what is used in gopher menus.+This option is especially useful to limit the addresses+.Xr spacecookie 1+will listen on since it listens on all available addresses+for incoming requests by default, i. e.+.Sy INADDR_ANY .+For example,+.Ql ::1+can be used to listen on the link-local addresses only+which comes in handy if you are setting up a onion service using+.Xr tor 1+and want to avoid leaking the server's identity.+.Pp+When given,+.Xr getaddrinfo 3+is used to resolve the given hostname or parse the given IP address and+.Xr spacecookie 1+will only listen on the resulting address(es).+Note that+.Sy IPV6_V6ONLY+is always disabled, so, if possible, both the resulting v4 and v6 address will be used.+.Pp+If+.Xr systemd.socket 5+activation is used, this setting has no effect.+.Pp+Type: string.+.El+.It Sy user+The name of the user spacecookie should run as.+When this option is given and not+.Ql null ,+.Xr spacecookie 1+will call+.Xr setuid 2+and+.Xr setgid 2+after setting up its socket to switch to that user and their primary group.+Note that this is only necessary to set if+.Xr spacecookie 1+is started with root privileges in the first place as the binary shouldn't have+the setuid bit set.+An alternative to starting the daemon as root, so it can bind its socket to a+well-known port, is to use+.Xr systemd 1+socket activation.+See the+.Xr spacecookie 1+man page for details on setting this up.+.Pp+Type: string.+Default:+.Ql null .+.It Sy log+Allows to customize the logging output of+.Xr spacecookie 1+to+.Sy stderr .+.Pp+Type: object.+.Bl -tag -offset 0n -width 2n+.It Sy enable+Wether to enable logging.+.Pp+Type: bool.+Default:+.Ql true .+.It Sy hide-ips+Wether to hide IP addresses of clients in the log output.+If enabled,+.Ql [redacted]+is displayed instead of client's IP addresses to avoid writing personal+information to disk.+.Pp+Type: bool.+Default:+.Ql true .+.It Sy hide-time+If this is set to+.Ql true ,+.Xr spacecookie 1+will not print timestamps at the beginning of every log line.+This is useful if you use an additional daemon or tool to take care of logs+which records timestamps automatically, like+.Xr systemd 1 .+.Pp+Type: bool.+Default:+.Ql false .+.It Sy level+Controls verbosity of logging.+It is recommended to either use+.Qq warn+or+.Qq info+since+.Qq error+hides warnings that are indicative of configuration issues.+.Pp+Type: either+.Qq error ,+.Qq warn+or+.Qq info .+Default:+.Qq info .+.El+.El+.Ss DEPRECATED SETTINGS+The following settings are only supported for backwards compatibility+and should be replaced in existing configurations in the way described+for each respectively.+.Pp+.Bl -tag -width 2n -offset 0n+.It Sy port+The top level+.Sy port+is an alias for the setting of the same name inside the+.Sy listen+object and should be replaced by the latter.+.El+.Sh EXAMPLE+The following configuration equates to the default behavior of+.Xr spacecookie 1+for all optional settings, although it is much verboser than necessary.+.Bd -literal -offset Ds+{+ "hostname" : "localhost",+ "root" : "/srv/gopher",+ "listen" : {+ "addr" : "::",+ "port" : 70+ },+ "user" : null,+ "log" : {+ "enable" : true,+ "hide-ips" : true,+ "hide-time" : false,+ "level" : "info"+ }+}+.Ed+.Pp+This configuration is suitable for running as an onion service:+It disables logging completely to not collect any kind of meta data about users+and only listens on the link-local address to avoid leaking its identity.+We can also use a non-well-known port since+.Xr tor 1+allows free mapping from local to exposed ports, so+.Xr spacecookie 1+can be started as a normal user.+.Bd -literal -offset Ds+{+ "hostname": "myonionservicehash.onion",+ "root": "/srv/onion-gopher",+ "listen": {+ "addr": "::1",+ "port": 7070+ },+ "log": {+ "enable": false+ }+}+.Ed+.Pp+If you are not using socket activation for running a gopher server on the+well-known port for gopher, a config like this is apporpriate, provided the+user+.Ql gopher+exists:+.Bd -literal -offset Ds+{+ "hostname": "example.org",+ "root": "/srv/gopher",+ "user": "gopher"+}+.Ed+.Pp+For a+.Xr systemd.socket 5+based setup, the+.Ql user+field should be omitted and+.Xr spacecookie 1+started as the target user directly in the+.Xr systemd.service 5+file.+.Sh SEE ALSO+.Xr spacecookie 1 .+.Sh AUTHORS+The+.Nm+documentation has been written by+.An sternenseemann ,+.Mt sterni-spacecookie@systemli.org .
etc/spacecookie.json view
@@ -1,6 +1,15 @@ { "hostname" : "localhost",- "port" : 7070,+ "listen" : {+ "addr" : "::",+ "port" : 70+ }, "user" : null,- "root" : "."+ "root" : "/srv/gopher",+ "log" : {+ "enable" : true,+ "hide-ips" : true,+ "hide-time" : false,+ "level" : "info"+ } }
− server/Config.hs
@@ -1,43 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Config- ( Config (..)- ) where--import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero)-import Data.Aeson-import Data.Aeson.Types-import Data.ByteString (ByteString ())-import qualified Data.ByteString as B-import Data.Maybe-import Network.Gopher.Util--data Config = Config { serverName :: ByteString- , serverPort :: Integer- , runUserName :: Maybe String- , rootDirectory :: FilePath- }--instance FromJSON Config where- parseJSON (Object v) = Config <$>- v .: "hostname" <*>- v .: "port" <*>- v .:? "user" <*>- v .: "root"- parseJSON _ = mzero--instance ToJSON Config where- toJSON (Config host port user root) = object $- [ "hostname" .= host- , "port" .= port- , "root" .= root- ] ++- maybe [] ((:[]) . ("user" .=)) user---- auxiliary instances for types that have no default instance-instance FromJSON ByteString where- parseJSON s@(String _) = uEncode <$> parseJSON s- parseJSON _ = mzero--instance ToJSON ByteString where- toJSON = toJSON . uDecode
server/Main.hs view
@@ -1,130 +1,207 @@ {-# LANGUAGE OverloadedStrings #-}-import Config-import Systemd+import Network.Spacecookie.Config+import Network.Spacecookie.FileType+import Network.Spacecookie.Systemd +import Paths_spacecookie (version)+ import Network.Gopher-import Network.Gopher.Util (santinizePath, uEncode)+import Network.Gopher.Util (sanitizePath, boolToMaybe, dropPrivileges) import Network.Gopher.Util.Gophermap-import Data.ByteString (ByteString ()) import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Data.List (isPrefixOf)-import Control.Applicative ((<|>), (<$>), pure)-import Control.Monad (unless, filterM, sequence, join)-import Control.Monad.IO.Class (liftIO)-import Data.Aeson (decode)+import Control.Applicative ((<|>))+import Control.Exception (catches, Handler (..))+import Control.Monad (when, unless)+import Data.Aeson (eitherDecodeFileStrict') import Data.Attoparsec.ByteString (parseOnly)-import Data.Char (toLower)-import Data.Maybe (fromJust)-import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)+import Data.Bifunctor (first)+import Data.ByteString.Builder (Builder ())+import Data.Either (rights)+import Data.Maybe (fromMaybe)+import Data.Version (showVersion)+import System.Console.GetOpt+import System.Directory (doesFileExist, getDirectoryContents) import System.Environment-import System.FilePath.Posix (takeFileName, takeExtension, (</>), dropDrive, splitDirectories)+import System.Exit+import System.FilePath.Posix.ByteString ( RawFilePath, takeFileName, (</>)+ , dropDrive, decodeFilePath+ , encodeFilePath)+import qualified System.Log.FastLogger as FL import System.Posix.Directory (changeWorkingDirectory)-import System.Socket (close)+import System.Socket (SocketException ()) +data Flags = Version | Usage++options :: [OptDescr Flags]+options =+ [ Option "h" [ "help", "usage" ] (NoArg Usage) "Print usage information"+ , Option [] [ "version" ] (NoArg Version) "Show used version of spacecookie"+ ]+ main :: IO () main = do args <- getArgs- case args of- [ configFile ] -> do- doesFileExist configFile >>= (flip unless) (error "could not open config file")- config' <- decode <$> BL.readFile configFile- case config' of- Just config -> do- changeWorkingDirectory (rootDirectory config)- let cfg = GopherConfig (serverName config) (serverPort config) (runUserName config)- runGopherManual (systemdSocket cfg)- (notifyReady >> pure ())- (\s -> notifyStopping >> systemdStoreOrClose s)- cfg spacecookie- Nothing -> error "failed to parse config"- _ -> error "config file must be given"+ case getOpt Permute options args of+ ([], [configFile], []) -> runServer configFile+ -- this works because we only have two flags atm+ ([Version], _, []) -> putStrLn $ showVersion version+ (_, _, []) -> printUsage+ (_, _, es) -> die . mconcat $+ "errors occurred while parsing options:\n":es -spacecookie :: String -> IO GopherResponse-spacecookie path' = do- let path = "." </> dropDrive (santinizePath path')- fileType <- gopherFileType path- pathType <- pathType path+runServer :: FilePath -> IO ()+runServer configFile = do+ doesFileExist configFile >>=+ (flip unless) (die "could not open config file")+ config' <- eitherDecodeFileStrict' configFile+ case config' of+ Left err -> die $ "failed to parse config: " ++ err+ Right config -> do+ changeWorkingDirectory (rootDirectory config)+ (logHandler, logStopAction) <- fromMaybe (Nothing, pure ())+ . fmap (first Just) <$> makeLogHandler (logConfig config)+ let cfg = GopherConfig+ { cServerName = serverName config+ , cListenAddr = listenAddr config+ , cServerPort = serverPort config+ , cLogHandler = logHandler+ }+ logIO = fromMaybe noLog logHandler - if not (isListable pathType path')- then pure . ErrorResponse $ "Accessing '" ++ path' ++ "' is not allowed."- else case fileType of- Error -> pure $- if "URL:" `isPrefixOf` path'- then ErrorResponse $ "spacecookie does not support proxying HTTP, try using a gopher client that supports the h-type. If you tried to request a file called '" ++ path' ++ "', it does not exist."- else ErrorResponse $ "The requested file '" ++ path' ++ "' does not exist or is not available."- -- always use gophermapResponse which falls back- -- to directoryResponse if there is no gophermap file- Directory -> gophermapResponse path- _ -> fileResponse path+ let setupFailureHandler e = do+ logIO GopherLogLevelError+ $ "Exception occurred in setup step: "+ <> toGopherLogStr (show e)+ logStopAction+ exitFailure+ catchSetupFailure a = a `catches`+ [ Handler (setupFailureHandler :: SystemdException -> IO ())+ , Handler (setupFailureHandler :: SocketException -> IO ())+ ] -fileResponse :: FilePath -> IO GopherResponse-fileResponse path = FileResponse <$> B.readFile path+ catchSetupFailure $ runGopherManual+ (systemdSocket cfg)+ (afterSocketSetup logIO config)+ (\s -> do+ _ <- notifyStopping+ logStopAction+ systemdStoreOrClose s)+ cfg+ (spacecookie logIO) -makeAbsolute :: FilePath -> FilePath-makeAbsolute x = if "./" `isPrefixOf` x- then tail x- else x+afterSocketSetup :: GopherLogHandler -> Config -> IO ()+afterSocketSetup logIO cfg = do+ case runUserName cfg of+ Nothing -> pure ()+ Just u -> do+ dropPrivileges u+ logIO GopherLogLevelInfo $ "Changed to user " <> toGopherLogStr u+ _ <- notifyReady+ pure () -directoryResponse :: FilePath -> IO GopherResponse-directoryResponse path = do- dir <- join (filterM (\x -> ((flip isListable) x) <$> pathType x) . map (path </>) <$> getDirectoryContents path)- fileTypes <- mapM gopherFileType dir- pure . MenuResponse . map (\f -> f Nothing Nothing) $ zipWith (\t f -> Item t (uEncode (takeFileName f)) f) fileTypes (map makeAbsolute dir)+printUsage :: IO ()+printUsage = do+ n <- getProgName+ putStrLn . flip usageInfo options $+ mconcat [ "Usage: ", n, " CONFIG\n" ] -gophermapResponse :: FilePath -> IO GopherResponse-gophermapResponse path = do- let gophermap = path </> ".gophermap"- exists <- doesFileExist gophermap- parsed <- if exists- then parseOnly parseGophermap <$> B.readFile gophermap- else pure $ Left "Gophermap file does not exist"- case parsed of- Left _ -> directoryResponse path- Right right -> pure $ gophermapToDirectoryResponse right+makeLogHandler :: LogConfig -> IO (Maybe (GopherLogHandler, IO ()))+makeLogHandler lc =+ let wrapTimedLogger :: FL.TimedFastLogger -> FL.FastLogger+ wrapTimedLogger logger str = logger $ (\t ->+ "[" <> FL.toLogStr t <> "]" <> str)+ formatLevel lvl =+ case lvl of+ GopherLogLevelInfo -> "[info] "+ GopherLogLevelWarn -> "[warn] "+ GopherLogLevelError -> "[err ] "+ processMsg =+ if logHideIps lc+ then hideSensitive+ else id+ logHandler :: FL.FastLogger -> GopherLogLevel -> GopherLogStr -> IO ()+ logHandler logger lvl msg = when (lvl <= logLevel lc) . logger+ $ formatLevel lvl+ <> ((FL.toLogStr :: Builder -> FL.LogStr) . fromGopherLogStr . processMsg $ msg)+ <> "\n"+ logType = FL.LogStderr FL.defaultBufSize+ in sequenceA . boolToMaybe (logEnable lc) $ do+ (logger, cleanup) <-+ if logHideTime lc+ then FL.newFastLogger logType+ else first wrapTimedLogger <$> do+ timeCache <- FL.newTimeCache FL.simpleTimeFormat+ FL.newTimedFastLogger timeCache logType+ pure (logHandler logger, cleanup) --- | calculates the file type identifier used in the Gopher protocol--- for a given file-gopherFileType :: FilePath -> IO GopherFileType-gopherFileType f = do- isDir <- ioCheck Directory doesDirectoryExist- isFile <- ioCheck File doesFileExist- let isGif = boolToMaybe GifFile $ takeExtension f == "gif"- let isImage = boolToMaybe ImageFile $ map toLower (takeExtension f) `elem` ["png", "jpg", "jpeg", "raw", "cr2", "nef"]- return . fromJust $- isDir <|> isGif <|> isImage <|> isFile <|> Just Error- where ioCheck onSuccess check = fmap (boolToMaybe onSuccess) . check $ f+noLog :: GopherLogHandler+noLog = const . const $ pure () --- | isListable filters out system files for directory listings-isListable :: PathType -> FilePath -> Bool-isListable Directory' "" = True -- "" is root-isListable _ "" = False-isListable DoesNotExist _ = False-isListable Directory' p- | (head . last . splitDirectories) p == '.' = False- | otherwise = True-isListable File' p- | head (takeFileName p) == '.' = False- | otherwise = True+spacecookie :: GopherLogHandler -> GopherRequest -> IO GopherResponse+spacecookie logger req = do+ let selector = requestSelector req+ path = "." </> dropDrive (sanitizePath selector)+ pt <- gopherFileType path --- | True -> Just a--- False -> Nothing-boolToMaybe :: a -> Bool -> Maybe a-boolToMaybe a True = Just a-boolToMaybe _ False = Nothing+ case pt of+ Left PathIsNotAllowed ->+ pure . ErrorResponse $ mconcat+ [ "Accessing '", selector, "' is not allowed." ]+ Left PathDoesNotExist -> pure $+ if "URL:" `B.isPrefixOf` selector+ then ErrorResponse $ mconcat+ [ "spacecookie does not support proxying HTTP, "+ , "try using a gopher client that supports URL: selectors. "+ , "If you tried to request a resource called '"+ , selector, "', it does not exist." ]+ else ErrorResponse $ mconcat+ [ "The requested resource '", selector+ , "' does not exist or is not available." ]+ Right ft ->+ case ft of+ Error -> pure $ ErrorResponse $ "An unknown error occurred"+ -- always use gophermapResponse which falls back+ -- to directoryResponse if there is no gophermap file+ Directory -> gophermapResponse logger path+ _ -> fileResponse logger path -data PathType- = Directory'- | File'- | DoesNotExist- deriving (Show, Eq)+fileResponse :: GopherLogHandler -> RawFilePath -> IO GopherResponse+fileResponse _ path = FileResponse <$> B.readFile (decodeFilePath path) -pathType :: FilePath -> IO PathType-pathType p = do- file <- doesFileExist p- dir <- doesDirectoryExist p- if file- then pure File'- else if dir- then pure Directory'- else pure DoesNotExist+makeAbsolute :: RawFilePath -> RawFilePath+makeAbsolute x = fromMaybe x+ $ boolToMaybe ("./" `B.isPrefixOf` x) (B.tail x)+ <|> boolToMaybe ("." == x) "/"++directoryResponse :: GopherLogHandler -> RawFilePath -> IO GopherResponse+directoryResponse _ path =+ let makeItem :: Either a GopherFileType -> RawFilePath -> Either a GopherMenuItem+ makeItem t file = do+ fileType <- t+ pure $+ Item fileType (takeFileName file) file Nothing Nothing+ in do+ dir <- map ((path </>) . encodeFilePath)+ <$> getDirectoryContents (decodeFilePath path)+ fileTypes <- mapM gopherFileType dir++ pure . MenuResponse . rights+ $ zipWith makeItem fileTypes (map makeAbsolute dir)++gophermapResponse :: GopherLogHandler -> RawFilePath -> IO GopherResponse+gophermapResponse logger path = do+ let gophermap = path </> ".gophermap"+ gophermapWide = decodeFilePath gophermap+ exists <- doesFileExist gophermapWide+ parsed <-+ if exists+ then parseOnly parseGophermap <$> B.readFile gophermapWide+ else pure $ Left "Gophermap file does not exist"+ case parsed of+ Left err -> do+ when exists . logger GopherLogLevelWarn+ $ "Could not parse gophermap at " <> toGopherLogStr gophermap+ <> ": " <> toGopherLogStr err+ directoryResponse logger path+ Right right -> pure+ $ gophermapToDirectoryResponse (makeAbsolute path) right
+ server/Network/Spacecookie/Config.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Spacecookie.Config+ ( Config (..)+ , LogConfig (..)+ ) where++import Control.Monad (mzero, join)+import Control.Applicative ((<|>))+import Data.Aeson+import Data.Aeson.Types (Parser ())+import Data.ByteString (ByteString ())+import Data.Text (toLower, Text ())+import Network.Gopher (GopherLogLevel (..))+import Network.Gopher.Util++data Config+ = Config+ { serverName :: ByteString+ , listenAddr :: Maybe ByteString+ , serverPort :: Integer+ , runUserName :: Maybe String+ , rootDirectory :: FilePath+ , logConfig :: LogConfig+ }++maybePath :: FromJSON a => [Text] -> Object -> Parser (Maybe a)+maybePath [] _ = fail "got empty path"+maybePath [x] v = v .:? x+maybePath (x:xs) v = v .:? x >>= fmap join . traverse (maybePath xs)++instance FromJSON Config where+ parseJSON (Object v) = Config+ <$> v .: "hostname"+ <*> maybePath [ "listen", "addr" ] v+ <*> parseListenPort v .!= 70+ <*> v .:? "user"+ <*> v .: "root"+ <*> v .:? "log" .!= defaultLogConfig+ parseJSON _ = mzero++-- Use '(<|>)' over the 'Maybe's in the parser rather+-- to only fallback on 'Nothing' and not on @empty@.+-- This way a parse error in listen → port doesn't get+-- promoted to just 'Nothing'.+parseListenPort :: Object -> Parser (Maybe Integer)+parseListenPort v = (<|>)+ <$> maybePath [ "listen", "port" ] v+ <*> (v .:? "port")++data LogConfig+ = LogConfig+ { logEnable :: Bool+ , logHideIps :: Bool+ , logHideTime :: Bool+ , logLevel :: GopherLogLevel+ }++defaultLogConfig :: LogConfig+defaultLogConfig = LogConfig True True False GopherLogLevelInfo++instance FromJSON LogConfig where+ parseJSON (Object v) = LogConfig+ <$> v .:? "enable" .!= logEnable defaultLogConfig+ <*> v .:? "hide-ips" .!= logHideIps defaultLogConfig+ <*> v .:? "hide-time" .!= logHideTime defaultLogConfig+ <*> v .:? "level" .!= logLevel defaultLogConfig+ parseJSON _ = mzero++-- auxiliary instances for types that have no default instance+instance FromJSON GopherLogLevel where+ parseJSON (String s) =+ case toLower s of+ "info" -> pure GopherLogLevelInfo+ "warn" -> pure GopherLogLevelWarn+ "error" -> pure GopherLogLevelError+ _ -> mzero+ parseJSON _ = mzero++instance FromJSON ByteString where+ parseJSON s@(String _) = uEncode <$> parseJSON s+ parseJSON _ = mzero++instance ToJSON ByteString where+ toJSON = toJSON . uDecode
+ server/Network/Spacecookie/FileType.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Spacecookie.FileType+ ( PathError (..)+ , gopherFileType+ -- exposed for tests+ , lookupSuffix+ ) where++import Control.Applicative ((<|>))+import qualified Data.ByteString as B+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Network.Gopher (GopherFileType (..))+import Network.Gopher.Util (boolToMaybe, asciiToLower)+import System.Directory (doesDirectoryExist, doesFileExist)+import System.FilePath.Posix.ByteString ( RawFilePath, takeExtension+ , splitDirectories, decodeFilePath)++fileTypeMap :: M.Map RawFilePath GopherFileType+fileTypeMap = M.fromList+ [ (".gif", GifFile)+ , (".png", ImageFile)+ , (".jpg", ImageFile)+ , (".jpeg", ImageFile)+ , (".tiff", ImageFile)+ , (".tif", ImageFile)+ , (".bmp", ImageFile)+ , (".webp", ImageFile)+ , (".apng", ImageFile)+ , (".mng", ImageFile)+ , (".heif", ImageFile)+ , (".heifs", ImageFile)+ , (".heic", ImageFile)+ , (".heics", ImageFile)+ , (".avci", ImageFile)+ , (".avcs", ImageFile)+ , (".avif", ImageFile)+ , (".avifs", ImageFile)+ , (".ico", ImageFile)+ , (".svg", ImageFile)+ , (".raw", ImageFile) -- TODO: RAW files should maybe be binary files?+ , (".cr2", ImageFile)+ , (".nef", ImageFile)+ , (".json", File)+ , (".txt", File)+ , (".text", File)+ , (".md", File)+ , (".mdown", File)+ , (".mkdn", File)+ , (".mkd", File)+ , (".markdown", File)+ , (".adoc", File)+ , (".rst", File)+ , (".zip", BinaryFile)+ , (".tar", BinaryFile)+ , (".gz", BinaryFile)+ , (".bzip2", BinaryFile)+ , (".xz", BinaryFile)+ , (".tgz", BinaryFile)+ , (".doc", BinaryFile)+ , (".hqx", BinHexMacintoshFile)+ ]++lookupSuffix :: RawFilePath -> GopherFileType+lookupSuffix = fromMaybe File+ . (flip M.lookup) fileTypeMap+ . B.map asciiToLower++data PathError+ = PathDoesNotExist+ | PathIsNotAllowed+ deriving (Show, Eq, Ord, Enum)++-- | Action in the 'Either' monad which causes a+-- failure if there's any dot files or directory+-- in the given path+checkNoDotFiles :: RawFilePath -> Either PathError ()+checkNoDotFiles path = do+ -- this prevents relative directories from being+ -- forbidden while singular '.' in the path somewhere+ -- get flagged and "." stays allowed.+ let segments = splitDirectories $ fromMaybe path+ $ boolToMaybe ("./" `B.isPrefixOf` path) (B.tail path)+ <|> boolToMaybe ("." == path) ""++ if any ((== ".") . B.take 1) segments+ then Left PathIsNotAllowed+ else Right ()++-- | calculates the file type identifier used in the Gopher+-- protocol for a given file and returns a descriptive error+-- if the file is not accessible or a dot file (and thus not+-- allowed to access)+gopherFileType :: RawFilePath -> IO (Either PathError GopherFileType)+gopherFileType path = (checkNoDotFiles path >>) <$> do+ let pathWide = decodeFilePath path+ isDir <- doesDirectoryExist pathWide+ if isDir+ then pure $ Right Directory+ else do+ fileExists <- doesFileExist pathWide+ pure $+ if fileExists+ then Right $ lookupSuffix $ takeExtension path+ else Left $ PathDoesNotExist
+ server/Network/Spacecookie/Systemd.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.Spacecookie.Systemd+ ( systemdSocket+ , notifyReady+ , notifyStopping+ , systemdStoreOrClose+ , SystemdException (..)+ ) where++import Control.Concurrent.MVar (newMVar, swapMVar, mkWeakMVar)+import Control.Exception.Base+import Control.Monad (when)+import Data.Maybe (fromMaybe)+import Foreign.C.Types (CInt (..))+import GHC.Conc (closeFdWith)+import Network.Gopher+import System.IO.Error (mkIOError, userErrorType)+import System.Posix.Types (Fd (..))+import System.Socket hiding (Error (..))+import System.Socket.Family.Inet6+import System.Socket.Type.Stream+import System.Socket.Protocol.TCP+import System.Socket.Unsafe (Socket (..))+import System.Systemd.Daemon (notifyReady, notifyStopping)+import System.Systemd.Daemon.Fd (storeFd, getActivatedSockets)++foreign import ccall unsafe "close"+ c_close :: CInt -> IO CInt++-- | Close a 'Fd' using close(1). Throws an 'IOException' on error.+closeFd :: Fd -> IO ()+closeFd fd = do+ res <- c_close $ fromIntegral fd+ when (res /= 0) $ throwIO+ $ mkIOError userErrorType "Could not close File Descriptor" Nothing Nothing++-- | Irreversibly convert a 'Socket' into an 'Fd'.+-- Invalidates the socket and returns the file descriptor+-- contained within it.+toFd :: Socket a b c -> IO Fd+toFd (Socket mvar) = fmap (Fd . fromIntegral) (swapMVar mvar (-1))+-- putting an invalid file descriptor into the 'MVar' makes+-- the 'Socket' appear to System.Socket as if it were closed++-- | Create an 'Socket' from an 'Fd'. This action is unsafe+-- since the type of the socket is not checked meaning that+-- whatever type the resulting 'Socket' has is not guaranteed+-- to be the same as its type indicates. Thus, this function+-- needs to be used with care so the safety guarantees of+-- 'Socket' are not violated.+--+-- Throws an 'IOException' if the 'Fd' is invalid.+fromFd :: Fd -> IO (Socket a b c)+fromFd fd = do+ -- TODO Validate socket type+ when (fd < 0) $ throwIO+ $ mkIOError userErrorType "Invalid File Descriptor" Nothing Nothing+ mfd <- newMVar (fromIntegral fd)+ let s = Socket mfd+ _ <- mkWeakMVar mfd (close s)+ pure s++data SystemdException+ = IncorrectNum+ deriving (Eq, Ord)++instance Exception SystemdException+instance Show SystemdException where+ show IncorrectNum = "SystemdException: Only exactly one Socket is supported"++systemdSocket :: GopherConfig -> IO (Socket Inet6 Stream TCP)+systemdSocket cfg = getActivatedSockets >>= \sockets ->+ case sockets of+ Nothing -> setupGopherSocket cfg+ Just [fd] -> do+ listenWarning+ fromFd fd+ Just _ -> throwIO IncorrectNum+ where listenWarning = fromMaybe (pure ()) $ do+ logAction <- cLogHandler cfg+ addr <- cListenAddr cfg+ pure . logAction GopherLogLevelWarn+ $ mconcat+ [ "Listen address ", toGopherLogStr addr+ , " specified, but started with systemd socket."+ , " Using systemd, listen address may differ." ]++systemdStoreOrClose :: Socket Inet6 Stream TCP -> IO ()+systemdStoreOrClose s = do+ fd <- toFd s+ res <- storeFd fd+ case res of+ Just () -> return ()+ Nothing -> closeFdWith closeFd fd
− server/Systemd.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE BlockArguments #-}-module Systemd- ( systemdSocket- , notifyReady- , notifyStopping- , systemdStoreOrClose- ) where--import Control.Concurrent.MVar (newMVar, takeMVar, mkWeakMVar)-import Control.Exception.Base-import Control.Monad (when, void)-import Foreign.C.Types (CInt (..))-import GHC.Conc (closeFdWith)-import Network.Gopher (setupGopherSocket, GopherConfig (..))-import System.Exit-import System.Posix.Types (Fd (..))-import System.Socket hiding (Error (..))-import System.Socket.Family.Inet6-import System.Socket.Type.Stream-import System.Socket.Protocol.TCP-import System.Socket.Unsafe (Socket (..))-import System.Systemd.Daemon (notifyReady, notifyStopping)-import System.Systemd.Daemon.Fd (storeFd, getActivatedSockets)--foreign import ccall unsafe "close"- c_close :: CInt -> IO CInt---- TODO Check Socket type, ...-data SystemdException = IncorrectNum | InvalidFd- deriving (Eq, Ord)--instance Show SystemdException where- show IncorrectNum = "SystemdException: Only exactly one Socket is supported"- show InvalidFd = "SystemdException: Invalid File Descriptor received"-instance Exception SystemdException--systemdSocket :: GopherConfig -> IO (Socket Inet6 Stream TCP)-systemdSocket cfg = getActivatedSockets >>= \sockets ->- case sockets of- Nothing -> setupGopherSocket cfg- Just [fd] -> toSocket fd- Just _ -> throwIO IncorrectNum- where toSocket :: Fd -> IO (Socket Inet6 Stream TCP)- toSocket fd = do- when (fd < 0) $ throwIO InvalidFd- mfd <- newMVar (fromIntegral fd)- let s = Socket mfd- _ <- mkWeakMVar mfd (close s)- pure s--systemdStoreOrClose :: Socket Inet6 Stream TCP -> IO ()-systemdStoreOrClose s = do- fd <- toFd s- res <- storeFd fd- case res of- Just () -> return ()- Nothing -> closeFdWith (void . c_close . fromIntegral) fd- where toFd :: Socket Inet6 Stream TCP -> IO Fd- toFd (Socket mvar) = fmap (Fd . fromIntegral) (takeMVar mvar)
spacecookie.cabal view
@@ -1,14 +1,14 @@-cabal-version: >= 2.0+cabal-version: 3.0 name: spacecookie-version: 0.2.1.2-synopsis: Gopher Library and Server Daemon+version: 1.0.0.0+synopsis: Gopher server library and daemon description: Simple gopher library that allows writing custom gopher applications. Also includes a fully-featured gopher server daemon complete with gophermap-support built on top of it.-license: GPL-3+license: GPL-3.0-only license-file: LICENSE author: Lukas Epple-maintainer: git@lukasepple.de+maintainer: sterni-spacecookie@systemli.org category: Network build-type: Simple homepage: https://github.com/sternenseemann/spacecookie@@ -18,52 +18,85 @@ etc/spacecookie.json etc/spacecookie.service etc/spacecookie.socket- docs/gophermap- docs/gophermap-pygopherd.txt docs/rfc1436.txt+ docs/man/spacecookie.1+ docs/man/spacecookie.json.5+ docs/man/spacecookie.gophermap.5+ test/data/pygopherd.gophermap+ test/data/bucktooth.gophermap+ test/integration/root/.gophermap+ test/integration/root/dir/.hidden+ test/integration/root/dir/another/.git-hello+ test/integration/root/dir/macintosh.hqx+ test/integration/root/dir/mystery-file+ test/integration/root/plain.txt+ test/integration/spacecookie.json +common common-settings+ default-language: Haskell2010+ build-depends: base >=4.9 && <5+ , bytestring >= 0.10+ , attoparsec >= 0.13+ , directory >= 1.3+ , filepath-bytestring >=1.4+ , containers >= 0.6++common gopher-dependencies+ build-depends: unix >= 2.7+ , socket >= 0.8.2+ , mtl >= 2.2+ , transformers >= 0.5+ , text >= 1.2+ executable spacecookie+ import: common-settings, gopher-dependencies main-is: Main.hs- build-depends: base >= 4.9.0.0 && <5- , socket- , unix- , directory- , filepath- , containers- , bytestring- , filepath- , mtl- , transformers- , aeson- , attoparsec- , spacecookie+ build-depends: spacecookie+ , aeson >= 1.5 , systemd >= 2.1.0+ , fast-logger >= 2.4.0 hs-source-dirs: server- default-language: Haskell2010- other-modules: Config- , Systemd+ other-modules: Network.Spacecookie.Config+ , Network.Spacecookie.Systemd+ , Network.Spacecookie.FileType+ , Paths_spacecookie+ autogen-modules: Paths_spacecookie+ ghc-options: -Wall -Wno-orphans -rtsopts -with-rtsopts=-I10 -threaded library+ import: common-settings, gopher-dependencies hs-source-dirs: src- default-language: Haskell2010 exposed-modules: Network.Gopher , Network.Gopher.Util.Gophermap , Network.Gopher.Util other-modules: Network.Gopher.Types- build-depends: base >= 4.9.0 && <5- , socket- , unix- , directory- , filepath- , containers- , bytestring- , filepath- , mtl- , transformers- , attoparsec- , hxt-unicode- , fast-logger >= 2.4.0 && < 3.1+ , Network.Gopher.Log+ , Network.Gopher.Util.Socket+ build-depends: hxt-unicode >= 9.0+ , async >= 2.2+ ghc-options: -Wall -Wno-orphans +test-suite test+ import: common-settings+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test, server+ other-modules: Test.FileTypeDetection+ , Test.Gophermap+ , Test.Integration+ , Network.Spacecookie.FileType+ build-depends: tasty >=1.2+ , tasty-hunit >=0.10+ , tasty-expected-failure >=0.11+ , spacecookie+ , process >=1.2.0+ , download-curl >=0.1+ ghc-options: -Wall -Wno-orphans+ source-repository head type: git location: git://github.com/sternenseemann/spacecookie.git++source-repository head+ type: git+ location: git://code.sterni.lv/spacecookie
src/Network/Gopher.hs view
@@ -6,240 +6,411 @@ = Overview -This is the main module of the spacecookie library. It allows to write gopher applications by taking care of handling gopher requests while leaving the application logic to a user-supplied function.+This is the main module of the spacecookie library.+It allows to write gopher applications by taking care of+handling gopher requests while leaving the application+logic to a user-supplied function. For a small tutorial an example of a trivial pure gopher application: @ {-# LANGUAGE OverloadedStrings #-}-import Network.Gopher-import Network.Gopher.Util+import "Network.Gopher"+import "Network.Gopher.Util" -main = do- 'runGopherPure' ('GopherConfig' "localhost" 7000 Nothing) (\\req -> 'FileResponse' ('uEncode' req))-@+cfg :: 'GopherConfig'+cfg = 'defaultConfig'+ { cServerName = "localhost"+ , cServerPort = 7000+ } -This server just returns the request string as a file.+handler :: 'GopherRequest' -> 'GopherResponse'+handler request =+ case 'requestSelector' request of+ "hello" -> 'FileResponse' "Hello, stranger!"+ "" -> rootMenu+ "/" -> rootMenu+ _ -> 'ErrorResponse' "Not found"+ where rootMenu = 'MenuResponse'+ [ 'Item' 'File' "greeting" "hello" Nothing Nothing ] -There are three possibilities for a 'GopherResponse':+main :: IO ()+main = 'runGopherPure' cfg handler+@ -* 'FileResponse': file type agnostic file response, takes a 'ByteString' to support both text and binary files-* 'MenuResponse': a gopher menu (“directory listning”) consisting of a list of 'GopherMenuItem's-* 'ErrorResponse': gopher way to show an error (e. g. if a file is not found). A 'ErrorResponse' results in a menu response with a single entry.+There are three possibilities for a 'GopherResponse': -If you use 'runGopher', it is the same story like in the example above, but you can do 'IO' effects. To see a more elaborate example, have a look at the server code in this package.+* 'FileResponse': file type agnostic file response, takes a+ 'ByteString' to support both text and binary files.+* 'MenuResponse': a gopher menu (“directory listing”) consisting of a+ list of 'GopherMenuItem's+* 'ErrorResponse': gopher way to show an error (e. g. if a file is not found).+ An 'ErrorResponse' results in a menu response with a single entry. -Note: In practice it is probably best to use record update syntax on 'defaultConfig' which won't break your application every time the config record fields are changed.+If you use 'runGopher', it is the same story like in the example above, but+you can do 'IO' effects. To see a more elaborate example, have a look at the+server code in this package. -} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Network.Gopher ( -- * Main API+ -- $runGopherVariants runGopher , runGopherPure , runGopherManual , GopherConfig (..) , defaultConfig- -- * Helper Functions- , gophermapToDirectoryResponse- , setupGopherSocket- -- * Representations+ -- ** Requests+ , GopherRequest (..) -- ** Responses , GopherResponse (..) , GopherMenuItem (..) , GopherFileType (..)+ -- * Helper Functions+ -- ** Logging+ -- $loggingDoc+ , GopherLogHandler+ , module Network.Gopher.Log+ -- ** Networking+ , setupGopherSocket -- ** Gophermaps+ -- $gophermapDoc+ , gophermapToDirectoryResponse+ , Gophermap , GophermapEntry (..)- , Gophermap (..) ) where import Prelude hiding (log) +import Network.Gopher.Log import Network.Gopher.Types import Network.Gopher.Util import Network.Gopher.Util.Gophermap+import Network.Gopher.Util.Socket -import Control.Applicative ((<$>), (<*>), Applicative (..))-import Control.Concurrent (forkIO, ThreadId ())-import Control.Exception (bracket, catch, IOException (..))-import Control.Monad (forever, when)+import Control.Concurrent (forkIO, ThreadId (), threadDelay)+import Control.Concurrent.Async (race)+import Control.Exception (bracket, catch, throw, SomeException (), Exception ())+import Control.Monad (forever, when, void) import Control.Monad.IO.Class (liftIO, MonadIO (..)) import Control.Monad.Reader (ask, runReaderT, MonadReader (..), ReaderT (..))-import Control.Monad.Error.Class (MonadError (..))+import Data.Bifunctor (second) import Data.ByteString (ByteString ()) import qualified Data.ByteString as B-import Data.Maybe (isJust, fromJust, fromMaybe)-import Data.Monoid ((<>))-import qualified Data.String.UTF8 as U-import System.IO-import System.Log.FastLogger-import System.Log.FastLogger.Date+import qualified Data.ByteString.Builder as BB+import Data.Maybe (fromMaybe)+import Data.Word (Word16 ()) import System.Socket hiding (Error (..)) import System.Socket.Family.Inet6-import System.Socket.Type.Stream+import System.Socket.Type.Stream (Stream, sendAllBuilder) import System.Socket.Protocol.TCP-import System.Posix.User --- | necessary information to handle gopher requests+-- | Necessary information to handle gopher requests data GopherConfig- = GopherConfig { cServerName :: ByteString -- ^ “name” of the server (either ip address or dns name)- , cServerPort :: Integer -- ^ port to listen on- , cRunUserName :: Maybe String -- ^ user to run the process as- }+ = GopherConfig+ { cServerName :: ByteString+ -- ^ Public name of the server (either ip address or dns name).+ -- Gopher clients will use this name to fetch any resources+ -- listed in gopher menus located on the same server.+ , cListenAddr :: Maybe ByteString+ -- ^ Address or hostname to listen on (resolved by @getaddrinfo@).+ -- If 'Nothing', listen on all addresses.+ , cServerPort :: Integer+ -- ^ Port to listen on+ , cLogHandler :: Maybe GopherLogHandler+ -- ^ 'IO' action spacecookie will call to output its log messages.+ -- If it is 'Nothing', logging is disabled. See [the logging section](#logging)+ -- for an overview on how to implement a log handler.+ } --- | Default 'GopherConfig' describing a server on @localhost:70@.+-- | Default 'GopherConfig' describing a server on @localhost:70@ with+-- no registered log handler. defaultConfig :: GopherConfig-defaultConfig = GopherConfig "localhost" 70 Nothing+defaultConfig = GopherConfig "localhost" Nothing 70 Nothing -data Env- = Env { serverSocket :: Socket Inet6 Stream TCP- , serverName :: ByteString- , serverPort :: Integer- , serverFun :: (String -> IO GopherResponse)- , logger :: (TimedFastLogger, IO ()) -- ^ TimedFastLogger and clean up action- }+-- | Type for an user defined 'IO' action which handles logging a+-- given 'GopherLogStr' of a given 'GopherLogLevel'. It may+-- process the string and format in any way desired, but it must+-- be thread safe and should not block (too long) since it+-- is called syncronously.+type GopherLogHandler = GopherLogLevel -> GopherLogStr -> IO () -initEnv :: Socket Inet6 Stream TCP -> ByteString -> Integer -> (String -> IO GopherResponse) -> IO Env-initEnv sock name port fun = do- timeCache <- newTimeCache simpleTimeFormat- logger <- newTimedFastLogger timeCache (LogStderr 128)- pure $ Env sock name port fun logger+-- $loggingDoc+-- #logging#+-- Logging may be enabled by providing 'GopherConfig' with an optional+-- 'GopherLogHandler' which implements processing, formatting and+-- outputting of log messages. While this requires extra work for the+-- library user it also allows the maximum freedom in used logging+-- mechanisms.+--+-- A trivial log handler could look like this:+--+-- @+-- logHandler :: 'GopherLogHandler'+-- logHandler level str = do+-- putStr $ show level ++ \": \"+-- putStrLn $ 'fromGopherLogStr' str+-- @+--+-- If you only want to log errors you can use the 'Ord' instance of+-- 'GopherLogLevel':+--+-- @+-- logHandler' :: 'GopherLogHandler'+-- logHandler' level str = when (level <= 'GopherLogLevelError')+-- $ logHandler level str+-- @+--+-- The library marks parts of 'GopherLogStr' which contain user+-- related data like IP addresses as sensitive using 'makeSensitive'.+-- If you don't want to e. g. write personal information to disk in+-- plain text, you can use 'hideSensitive' to transparently remove+-- that information. Here's a quick example in GHCi:+--+-- >>> hideSensitive $ "Look at my " <> makeSensitive "secret"+-- "Look at my [redacted]" +-- $gophermapDoc+-- Helper functions for converting 'Gophermap's into 'MenuResponse's.+-- For parsing gophermap files, refer to "Network.Gopher.Util.Gophermap".++data GopherRequest+ = GopherRequest+ { requestRawSelector :: ByteString+ -- ^ raw selector sent by the client (without the terminating @\\r\\n@+ , requestSelector :: ByteString+ -- ^ only the request selector minus the search expression if present+ , requestSearchString :: Maybe ByteString+ -- ^ raw search string if the clients sends a search transaction+ , requestClientAddr :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)+ -- ^ IPv6 address of the client which sent the request. IPv4 addresses are+ -- <https://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses mapped>+ -- to an IPv6 address.+ } deriving (Show, Eq)++data Env+ = Env+ { serverConfig :: GopherConfig+ , serverFun :: GopherRequest -> IO GopherResponse+ }+ newtype GopherM a = GopherM { runGopherM :: ReaderT Env IO a }- deriving ( Functor, Applicative, Monad- , MonadIO, MonadReader Env, MonadError IOException)+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env) +gopherM :: Env -> GopherM a -> IO a gopherM env action = (runReaderT . runGopherM) action env -data LogMessage = LogError String | LogInfo String+-- call given log handler if it is Just+logIO :: Maybe GopherLogHandler -> GopherLogLevel -> GopherLogStr -> IO ()+logIO h l = fromMaybe (const (pure ())) $ ($ l) <$> h -instance ToLogStr LogMessage where- toLogStr (LogError s) = "[Error] " <> toLogStr s- toLogStr (LogInfo s) = "[Info] " <> toLogStr s+logInfo :: GopherLogStr -> GopherM ()+logInfo = log GopherLogLevelInfo -log :: LogMessage -> GopherM ()-log logMsg = do- (logger, _) <- logger <$> ask- liftIO $ logger (\t -> "[" <> toLogStr t <> "]" <> (toLogStr logMsg) <> "\n")+logError :: GopherLogStr -> GopherM ()+logError = log GopherLogLevelError -prettyAddr :: SocketAddress Inet6 -> String-prettyAddr (SocketAddressInet6 addr port _ _) = drop 13 (show addr) <> ":" <> show (fromIntegral port)+log :: GopherLogLevel -> GopherLogStr -> GopherM ()+log l m = do+ h <- cLogHandler . serverConfig <$> ask+ liftIO $ logIO h l m -receiveRequest :: Socket Inet6 Stream TCP -> IO ByteString-receiveRequest sock = receiveRequest' sock mempty- where lengthLimit = 1024- receiveRequest' sock acc = do- bs <- liftIO $ receive sock lengthLimit mempty- case (B.elemIndex (asciiOrd '\n') bs) of- Just i -> return (acc `B.append` (B.take (i + 1) bs))- Nothing -> if B.length bs < lengthLimit- then return (acc `B.append` bs)- else receiveRequest' sock (acc `B.append` bs)+logException :: Exception e => Maybe GopherLogHandler -> GopherLogStr -> e -> IO ()+logException logger msg e =+ logIO logger GopherLogLevelError $ msg <> toGopherLogStr (show e) -dropPrivileges :: String -> IO Bool-dropPrivileges username = do- uid <- getRealUserID- if (uid /= 0)- then return False- else do- user <- getUserEntryForName username- setGroupID $ userGroupID user- setUserID $ userID user- return True+-- | Read request from a client socket.+-- The complexity of this function is caused by the+-- following design features:+--+-- * Requests may be terminated by either "\n\r" or "\n"+-- * After the terminating newline no extra data is accepted+-- * Give up on waiting on a request from the client after+-- a certain amount of time (request timeout)+-- * Don't accept selectors bigger than a certain size to+-- avoid DoS attacks filling up our memory.+receiveRequest :: Socket Inet6 Stream TCP -> IO (Either ByteString ByteString)+receiveRequest sock = fmap (either id id)+ $ race (threadDelay reqTimeout >> pure (Left "Request Timeout")) $ do+ req <- loop mempty 0+ pure $+ case B.break newline req of+ (r, "\r\n") -> Right r+ (r, "\n") -> Right r+ (_, "") -> Left "Request too big or unterminated"+ _ -> Left "Unexpected data after newline"+ where newline = (||)+ <$> (== asciiOrd '\n')+ <*> (== asciiOrd '\r')+ reqTimeout = 10000000 -- 10s+ maxSize = 1024 * 1024+ loop bs size = do+ part <- receive sock maxSize msgNoSignal+ let newSize = size + B.length part+ if newSize >= maxSize || part == mempty || B.elem (asciiOrd '\n') part+ then pure $ bs `mappend` part+ else loop (bs `mappend` part) newSize -- | Auxiliary function that sets up the listening socket for -- 'runGopherManual' correctly and starts to listen.+--+-- May throw a 'SocketException' if an error occurs while+-- setting up the socket. setupGopherSocket :: GopherConfig -> IO (Socket Inet6 Stream TCP) setupGopherSocket cfg = do sock <- (socket :: IO (Socket Inet6 Stream TCP)) setSocketOption sock (ReuseAddress True) setSocketOption sock (V6Only False)- bind sock (SocketAddressInet6 inet6Any (fromInteger (cServerPort cfg)) 0 0)+ addr <-+ case cListenAddr cfg of+ Nothing -> pure+ $ SocketAddressInet6 inet6Any (fromInteger (cServerPort cfg)) 0 0+ Just a -> do+ let port = uEncode . show $ cServerPort cfg+ let flags = aiV4Mapped <> aiNumericService+ addrs <- (getAddressInfo (Just a) (Just port) flags :: IO [AddressInfo Inet6 Stream TCP])++ -- should be done by getAddressInfo already+ when (null addrs) $ throw eaiNoName++ pure . socketAddress $ head addrs+ bind sock addr listen sock 5 pure sock +-- $runGopherVariants+-- The @runGopher@ function variants will generally not throw exceptions,+-- but handle them somehow (usually by logging that a non-fatal exception+-- occurred) except if the exception occurrs in the setup step of+-- 'runGopherManual'.+--+-- You'll have to handle those exceptions yourself. To see which exceptions+-- can be thrown by 'runGopher' and 'runGopherPure', read the documentation+-- of 'setupGopherSocket'.+ -- | Run a gopher application that may cause effects in 'IO'.--- The application function is given the gopher request (path)--- and required to produce a GopherResponse.-runGopher :: GopherConfig -> (String -> IO GopherResponse) -> IO ()+-- The application function is given the 'GopherRequest'+-- sent by the client and must produce a GopherResponse.+runGopher :: GopherConfig -> (GopherRequest -> IO GopherResponse) -> IO () runGopher cfg f = runGopherManual (setupGopherSocket cfg) (pure ()) close cfg f -- | Same as 'runGopher', but allows you to setup the 'Socket' manually--- and calls an action of type @IO ()@ as soon as the server is ready--- to accept requests. When the server terminates, it calls the action--- of type @Socket Inet6 Stream TCP -> IO ()@ to clean up the socket.+-- and calls an user provided action soon as the server is ready+-- to accept requests. When the server terminates, it calls the given+-- clean up action which must close the socket and may perform other+-- shutdown tasks (like notifying a supervisor it is stopping). -- -- Spacecookie assumes the 'Socket' is properly set up to listen on the -- port and host specified in the 'GopherConfig' (i. e. 'bind' and -- 'listen' have been called). This can be achieved using 'setupGopherSocket'.+-- Especially note that spacecookie does /not/ check if the listening+-- address and port of the given socket match 'cListenAddr' and+-- 'cServerPort'. ----- This is intended for supporting systemd socket activation and storage.--- Only use, if you know what you are doing.-runGopherManual :: IO (Socket Inet6 Stream TCP) -> IO () -> (Socket Inet6 Stream TCP -> IO ())- -> GopherConfig -> (String -> IO GopherResponse) -> IO ()-runGopherManual sock ready term cfg f = bracket- sock+-- This is intended for supporting systemd socket activation and storage,+-- but may also be used to support other use cases where more control is+-- necessary. Always use 'runGopher' if possible, as it offers less ways+-- of messing things up.+runGopherManual :: IO (Socket Inet6 Stream TCP) -- ^ action to set up listening socket+ -> IO () -- ^ ready action called after startup+ -> (Socket Inet6 Stream TCP -> IO ()) -- ^ socket clean up action+ -> GopherConfig -- ^ server config+ -> (GopherRequest -> IO GopherResponse) -- ^ request handler+ -> IO ()+runGopherManual sockAction ready term cfg f = bracket+ sockAction term (\sock -> do- env <- initEnv sock (cServerName cfg) (fromInteger (cServerPort cfg)) f- gopherM env $ do+ gopherM (Env cfg f) $ do addr <- liftIO $ getAddress sock- log . LogInfo $ "Now listening on " ++ prettyAddr addr-- -- Change UID and GID if necessary- when (isJust (cRunUserName cfg)) $ do- success <- liftIO (dropPrivileges (fromJust (cRunUserName cfg)))- if success- then log . LogInfo $ "Changed to user " ++ fromJust (cRunUserName cfg)- else log . LogError $ "Could not change UID: not started as root!"+ logInfo $ "Listening on " <> toGopherLogStr addr liftIO $ ready - (forever (acceptAndHandle sock) `catchError`- (\e -> do- log . LogError $ show e- snd . logger <$> ask >>= liftIO)))+ forever $ acceptAndHandle sock) -forkGopherM :: GopherM () -> GopherM ThreadId-forkGopherM action = ask >>= liftIO . forkIO . (flip gopherM) action+forkGopherM :: GopherM () -> IO () -> GopherM ThreadId+forkGopherM action cleanup = do+ env <- ask+ liftIO $ forkIO $ do+ gopherM env action `catch`+ (logException+ (cLogHandler $ serverConfig env)+ "Thread failed with exception: " :: SomeException -> IO ())+ cleanup +-- | Split an selector in the actual search selector and+-- an optional search expression as documented in the+-- RFC1436 appendix.+splitSelector :: ByteString -> (ByteString, Maybe ByteString)+splitSelector = second checkSearch . B.breakSubstring "\t"+ where checkSearch search =+ if B.length search > 1+ then Just $ B.tail search+ else Nothing+ handleIncoming :: Socket Inet6 Stream TCP -> SocketAddress Inet6 -> GopherM ()-handleIncoming clientSock addr = do- req <- liftIO $ uDecode . stripNewline <$> receiveRequest clientSock- log . LogInfo $ "Got request '" ++ req ++ "' from " ++ prettyAddr addr+handleIncoming clientSock addr@(SocketAddressInet6 cIpv6 _ _ _) = do+ request <- liftIO $ receiveRequest clientSock+ logger <- cLogHandler . serverConfig <$> ask+ intermediateResponse <-+ case request of+ Left e -> pure $ ErrorResponse e+ Right rawSelector -> do+ let (onlySel, search) = splitSelector rawSelector+ req = GopherRequest+ { requestRawSelector = rawSelector+ , requestSelector = onlySel+ , requestSearchString = search+ , requestClientAddr = inet6AddressToTuple cIpv6+ } - fun <- serverFun <$> ask- res <- liftIO (fun req) >>= response+ logInfo $ "New Request \"" <> toGopherLogStr rawSelector <> "\" from "+ <> makeSensitive (toGopherLogStr addr) - liftIO $ sendAll clientSock res msgNoSignal- liftIO $ close clientSock- log . LogInfo $ "Closed connection succesfully to " ++ prettyAddr addr+ fun <- serverFun <$> ask+ liftIO $ fun req `catch` \e -> do+ let msg = "Unhandled exception in handler: "+ <> toGopherLogStr (show (e :: SomeException))+ logIO logger GopherLogLevelError msg+ pure $ ErrorResponse "Unknown error occurred" + rawResponse <- response intermediateResponse++ liftIO $ void (sendAllBuilder clientSock 10240 rawResponse msgNoSignal) `catch` \e ->+ logException logger "Exception while sending response to client: " (e :: SocketException)+ acceptAndHandle :: Socket Inet6 Stream TCP -> GopherM () acceptAndHandle sock = do- (clientSock, addr) <- liftIO $ accept sock- log . LogInfo $ "Accepted Connection from " ++ prettyAddr addr- forkGopherM $ handleIncoming clientSock addr `catchError` (\e -> do- liftIO (close clientSock)- log . LogError $ "Closed connection to " ++ prettyAddr addr ++ " after error: " ++ show e)- return ()+ connection <- liftIO $ fmap Right (accept sock) `catch` (pure . Left)+ case connection of+ Left e -> logError $ "Failure while accepting connection "+ <> toGopherLogStr (show (e :: SocketException))+ Right (clientSock, addr) -> do+ logInfo $ "New connection from " <> makeSensitive (toGopherLogStr addr)+ void $ forkGopherM (handleIncoming clientSock addr) (gracefulClose clientSock) --- | Run a gopher application that may not cause effects in 'IO'.-runGopherPure :: GopherConfig -> (String -> GopherResponse) -> IO ()+-- | Like 'runGopher', but may not cause effects in 'IO' (or anywhere else).+runGopherPure :: GopherConfig -> (GopherRequest -> GopherResponse) -> IO () runGopherPure cfg f = runGopher cfg (fmap pure f) -response :: GopherResponse -> GopherM ByteString-response (MenuResponse items) = do- env <- ask- pure $ foldl (\acc (Item fileType title path host port) ->- B.append acc $- fileTypeToChar fileType `B.cons`- B.concat [ title, uEncode "\t", uEncode path, uEncode "\t", fromMaybe (serverName env) host,- uEncode "\t", uEncode . show $ fromMaybe (serverPort env) port, uEncode "\r\n" ])- B.empty items--response (FileResponse str) = pure str-response (ErrorResponse reason) = do- env <- ask- pure $ fileTypeToChar Error `B.cons`- B.concat [uEncode reason, uEncode $ "\tErr\t", serverName env, uEncode "\t", uEncode . show $ serverPort env, uEncode "\r\n"]+response :: GopherResponse -> GopherM BB.Builder+response (FileResponse str) = pure $ BB.byteString str+response (ErrorResponse reason) = response . MenuResponse $+ [ Item Error reason "Err" Nothing Nothing ]+response (MenuResponse items) =+ let appendItem cfg acc (Item fileType title path host port) =+ acc <> BB.word8 (fileTypeToChar fileType) <> mconcat+ [ BB.byteString title+ , BB.charUtf8 '\t'+ , BB.byteString path+ , BB.charUtf8 '\t'+ , BB.byteString $ fromMaybe (cServerName cfg) host+ , BB.charUtf8 '\t'+ , BB.intDec . fromIntegral $ fromMaybe (cServerPort cfg) port+ , BB.byteString "\r\n"+ ]+ in do+ cfg <- serverConfig <$> ask+ pure $ foldl (appendItem cfg) mempty items
+ src/Network/Gopher/Log.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module is completely exposed by 'Network.Gopher'+module Network.Gopher.Log+ ( GopherLogStr ()+ , makeSensitive+ , hideSensitive+ , GopherLogLevel (..)+ , ToGopherLogStr (..)+ , FromGopherLogStr (..)+ ) where++import Network.Gopher.Util (uEncode, uDecode)++import Data.ByteString.Builder (Builder ())+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Builder as BB+import qualified Data.Sequence as S+import Data.String (IsString (..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import System.Socket.Family.Inet6++-- | Indicates the log level of a 'GopherLogStr' to a+-- 'Network.Gopher.GopherLogHandler'. If you want to+-- filter by log level you can use either the 'Ord'+-- or 'Enum' instance of 'GopherLogLevel' as the following+-- holds:+--+-- @+-- 'GopherLogLevelError' < 'GopherLogLevelWarn' < 'GopherLogLevelInfo'+-- @+data GopherLogLevel+ = GopherLogLevelError+ | GopherLogLevelWarn+ | GopherLogLevelInfo+ deriving (Show, Eq, Ord, Enum)++-- | UTF-8 encoded string which may have parts of it marked as+-- sensitive (see 'makeSensitive'). Use its 'ToGopherLogStr',+-- 'Semigroup' and 'IsString' instances to construct+-- 'GopherLogStr's and 'FromGopherLogStr' to convert to the+-- commonly used Haskell string types.+newtype GopherLogStr+ = GopherLogStr { unGopherLogStr :: S.Seq GopherLogStrChunk }++instance Show GopherLogStr where+ show = show . (fromGopherLogStr :: GopherLogStr -> String)++instance Semigroup GopherLogStr where+ GopherLogStr s1 <> GopherLogStr s2 = GopherLogStr (s1 <> s2)++instance Monoid GopherLogStr where+ mempty = GopherLogStr mempty++instance IsString GopherLogStr where+ fromString = toGopherLogStr++data GopherLogStrChunk+ = GopherLogStrChunk+ { glscSensitive :: Bool+ , glscBuilder :: Builder+ }++-- | Mark a 'GopherLogStr' as sensitive. This is used by this+-- library mostly to mark IP addresses of connecting clients.+-- By using 'hideSensitive' on a 'GopherLogStr' sensitive+-- parts will be hidden from the string — even if the sensitive+-- string was concatenated to other strings.+makeSensitive :: GopherLogStr -> GopherLogStr+makeSensitive = GopherLogStr+ . fmap (\c -> c { glscSensitive = True })+ . unGopherLogStr++-- | Replaces all chunks of the 'GopherLogStr' that have been+-- marked as sensitive by 'makeSensitive' with @[redacted]@.+-- Note that the chunking is dependent on the way the string+-- was assembled by the user and the internal implementation+-- of 'GopherLogStr' which can lead to multiple consecutive+-- @[redacted]@ being returned unexpectedly. This may be+-- improved in the future.+hideSensitive :: GopherLogStr -> GopherLogStr+hideSensitive = GopherLogStr+ . fmap (\c -> GopherLogStrChunk False $+ if glscSensitive c+ then BB.byteString "[redacted]"+ else glscBuilder c)+ . unGopherLogStr++-- | Convert 'GopherLogStr's to other string types. Since it is used+-- internally by 'GopherLogStr', it is best to use the 'Builder'+-- instance for performance if possible.+class FromGopherLogStr a where+ fromGopherLogStr :: GopherLogStr -> a++instance FromGopherLogStr GopherLogStr where+ fromGopherLogStr = id++instance FromGopherLogStr Builder where+ fromGopherLogStr = foldMap glscBuilder . unGopherLogStr++instance FromGopherLogStr BL.ByteString where+ fromGopherLogStr = BB.toLazyByteString . fromGopherLogStr++instance FromGopherLogStr B.ByteString where+ fromGopherLogStr = BL.toStrict . fromGopherLogStr++instance FromGopherLogStr T.Text where+ fromGopherLogStr = T.decodeUtf8 . fromGopherLogStr++instance FromGopherLogStr TL.Text where+ fromGopherLogStr = TL.decodeUtf8 . fromGopherLogStr++instance FromGopherLogStr [Char] where+ fromGopherLogStr = uDecode . fromGopherLogStr++-- | Convert something to a 'GopherLogStr'. In terms of+-- performance it is best to implement a 'Builder' for+-- the type you are trying to render to 'GopherLogStr'+-- and then reuse its 'ToGopherLogStr' instance.+class ToGopherLogStr a where+ toGopherLogStr :: a -> GopherLogStr++instance ToGopherLogStr GopherLogStr where+ toGopherLogStr = id++instance ToGopherLogStr Builder where+ toGopherLogStr b = GopherLogStr+ . S.singleton+ $ GopherLogStrChunk+ { glscSensitive = False+ , glscBuilder = b+ }++instance ToGopherLogStr B.ByteString where+ toGopherLogStr = toGopherLogStr . BB.byteString++instance ToGopherLogStr BL.ByteString where+ toGopherLogStr = toGopherLogStr . BB.lazyByteString++instance ToGopherLogStr [Char] where+ toGopherLogStr = toGopherLogStr . uEncode++instance ToGopherLogStr GopherLogLevel where+ toGopherLogStr l =+ case l of+ GopherLogLevelInfo -> toGopherLogStr ("info" :: B.ByteString)+ GopherLogLevelWarn -> toGopherLogStr ("warn" :: B.ByteString)+ GopherLogLevelError -> toGopherLogStr ("error" :: B.ByteString)++instance ToGopherLogStr (SocketAddress Inet6) where+ -- TODO shorten address if possible+ toGopherLogStr (SocketAddressInet6 addr port _ _) =+ let (b1, b2, b3, b4, b5, b6, b7, b8) = inet6AddressToTuple addr+ in toGopherLogStr $+ BB.charUtf8 '[' <>+ BB.word16HexFixed b1 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b2 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b3 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b4 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b5 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b6 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b7 <> BB.charUtf8 ':' <>+ BB.word16HexFixed b8 <> BB.charUtf8 ']' <>+ BB.charUtf8 ':' <> BB.intDec (fromIntegral port)
src/Network/Gopher/Types.hs view
@@ -8,27 +8,24 @@ ) where -import Prelude hiding (lookup)+import Prelude hiding (lookup) -import Network.Gopher.Util+import Network.Gopher.Util -import Data.ByteString (ByteString, pack, unpack)-import qualified Data.ByteString as B-import Data.Char (ord, chr)-import Data.Map (Map (), fromList, lookup)-import Data.Maybe (fromJust, fromMaybe)-import Data.Tuple (swap)-import Data.Word (Word8 ())-import System.FilePath (splitPath, takeBaseName)+import Data.ByteString (ByteString ())+import Data.Word (Word8 ()) -- | entry in a gopher menu-data GopherMenuItem = Item GopherFileType ByteString FilePath (Maybe ByteString) (Maybe Integer) -- ^ file type, menu text, filepath (does not need to be a real file), server name (optional), port (optional)+data GopherMenuItem+ = Item GopherFileType ByteString ByteString (Maybe ByteString) (Maybe Integer)+ -- ^ file type, menu text, selector, server name (optional), port (optional).+ -- None of the given 'ByteString's may contain tab characters. deriving (Show, Eq) data GopherResponse = MenuResponse [GopherMenuItem] -- ^ gopher menu, wrapper around a list of 'GopherMenuItem's | FileResponse ByteString -- ^ return the given 'ByteString' as a file- | ErrorResponse String -- ^ gopher menu containing a single error with the given 'String' as text+ | ErrorResponse ByteString -- ^ gopher menu containing a single error with the given 'ByteString' as text deriving (Show, Eq) -- | rfc-defined gopher file types plus info line and HTML
src/Network/Gopher/Util.hs view
@@ -8,24 +8,27 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Gopher.Util ( -- * Security- santinizePath- , santinizeIfNotUrl+ sanitizePath+ , sanitizeIfNotUrl+ , dropPrivileges -- * String Encoding , asciiOrd , asciiChr+ , asciiToLower , uEncode , uDecode -- * Misc Helpers , stripNewline+ , boolToMaybe ) where import Data.ByteString (ByteString ()) import qualified Data.ByteString as B-import Data.Char (ord, chr)-import Data.List (isPrefixOf)+import Data.Char (ord, chr, toLower) import qualified Data.String.UTF8 as U import Data.Word (Word8 ())-import System.FilePath.Posix (pathSeparator, normalise, joinPath, splitPath)+import System.FilePath.Posix.ByteString (RawFilePath, normalise, joinPath, splitPath)+import System.Posix.User -- | 'chr' a 'Word8' asciiChr :: Word8 -> Char@@ -35,6 +38,17 @@ asciiOrd :: Char -> Word8 asciiOrd = fromIntegral . ord +-- | Transform a 'Word8' to lowercase if the solution is in bounds.+asciiToLower :: Word8 -> Word8+asciiToLower w =+ if inBounds lower+ then fromIntegral lower+ else w+ where inBounds i = i >= fromIntegral (minBound :: Word8) &&+ i <= fromIntegral (maxBound :: Word8)+ lower :: Int+ lower = ord . toLower . asciiChr $ w+ -- | Encode a 'String' to a UTF-8 'ByteString' uEncode :: String -> ByteString uEncode = B.pack . U.encode@@ -52,10 +66,33 @@ | otherwise = B.head s `B.cons` stripNewline (B.tail s) -- | Normalise a path and prevent <https://en.wikipedia.org/wiki/Directory_traversal_attack directory traversal attacks>.-santinizePath :: FilePath -> FilePath-santinizePath path = joinPath . filter (\p -> p /= ".." && p /= ".") . splitPath . normalise $ path+sanitizePath :: RawFilePath -> RawFilePath+sanitizePath = joinPath+ . filter (\p -> p /= ".." && p /= ".")+ . splitPath . normalise -santinizeIfNotUrl :: FilePath -> FilePath-santinizeIfNotUrl path = if "URL:" `isPrefixOf` path- then path- else santinizePath path+-- | Use 'sanitizePath' except if the path starts with @URL:@+-- in which case the original string is returned.+sanitizeIfNotUrl :: RawFilePath -> RawFilePath+sanitizeIfNotUrl path =+ if "URL:" `B.isPrefixOf` path+ then path+ else sanitizePath path++-- | prop> boolToMaybe True x == Just x+-- prop> boolToMaybe False x == Nothing+boolToMaybe :: Bool -> a -> Maybe a+boolToMaybe True a = Just a+boolToMaybe False _ = Nothing++-- | Call 'setGroupID' and 'setUserID' to switch to+-- the given user and their primary group.+-- Requires special privileges.+-- Will raise an exception if either the user+-- does not exist or the current user has no+-- permission to change UID/GID.+dropPrivileges :: String -> IO ()+dropPrivileges username = do+ user <- getUserEntryForName username+ setGroupID $ userGroupID user+ setUserID $ userID user
src/Network/Gopher/Util/Gophermap.hs view
@@ -3,7 +3,7 @@ Stability : experimental Portability : POSIX -This module implements a parser for <https://raw.githubusercontent.com/sternenseemann/spacecookie/master/docs/gophermap-pygopherd.txt gophermap files>.+This module implements a parser for gophermap files. Example usage: @@ -24,7 +24,8 @@ module Network.Gopher.Util.Gophermap ( parseGophermap , GophermapEntry (..)- , Gophermap (..)+ , GophermapFilePath (..)+ , Gophermap , gophermapToDirectoryResponse ) where @@ -33,56 +34,78 @@ import Network.Gopher.Types import Network.Gopher.Util -import Control.Applicative (many, (<$>), (<|>))-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Reader (ask)+import Control.Applicative ((<|>)) import Data.Attoparsec.ByteString-import Data.ByteString (ByteString (), append, empty, pack, singleton, unpack)+import Data.ByteString (ByteString (), pack, unpack, isPrefixOf) import Data.Maybe (fromMaybe) import qualified Data.String.UTF8 as U import Data.Word (Word8 ())+import System.FilePath.Posix.ByteString (RawFilePath, (</>)) --- | Convert a gophermap to a gopher menu response.-gophermapToDirectoryResponse :: Gophermap -> GopherResponse-gophermapToDirectoryResponse entries =- MenuResponse (map gophermapEntryToMenuItem entries)+-- | Given a directory and a Gophermap contained within it,+-- return the corresponding gopher menu response.+gophermapToDirectoryResponse :: RawFilePath -> Gophermap -> GopherResponse+gophermapToDirectoryResponse dir entries =+ MenuResponse (map (gophermapEntryToMenuItem dir) entries) -gophermapEntryToMenuItem :: GophermapEntry -> GopherMenuItem-gophermapEntryToMenuItem (GophermapEntry ft desc path host port) =- Item ft desc (fromMaybe (uDecode desc) path) host port+gophermapEntryToMenuItem :: RawFilePath -> GophermapEntry -> GopherMenuItem+gophermapEntryToMenuItem dir (GophermapEntry ft desc path host port) =+ Item ft desc (fromMaybe desc (realPath <$> path)) host port+ where realPath p =+ case p of+ GophermapAbsolute p' -> p'+ GophermapRelative p' -> dir </> p'+ GophermapUrl u -> u fileTypeChars :: [Char] fileTypeChars = "0123456789+TgIih" +-- | Wrapper around 'RawFilePath' to indicate whether it is+-- relative or absolute.+data GophermapFilePath+ = GophermapAbsolute RawFilePath -- ^ Absolute path starting with @/@+ | GophermapRelative RawFilePath -- ^ Relative path+ | GophermapUrl RawFilePath -- ^ URL to another protocol starting with @URL:@+ deriving (Show, Eq)++-- | Take 'ByteString' from gophermap, decode it,+-- sanitize and determine path type.+--+-- * Gophermap paths that start with a slash are+-- considered to be absolute.+-- * Gophermap paths that start with "URL:" are+-- considered as an external URL and left as-is.+-- * everything else is considered a relative path+makeGophermapFilePath :: ByteString -> GophermapFilePath+makeGophermapFilePath b =+ fromMaybe (GophermapRelative $ sanitizePath b)+ $ boolToMaybe ("URL:" `isPrefixOf` b) (GophermapUrl b)+ <|> boolToMaybe ("/" `isPrefixOf` b) (GophermapAbsolute $ sanitizePath b)+ -- | A gophermap entry makes all values of a gopher menu item optional except for file type and description. When converting to a 'GopherMenuItem', appropriate default values are used. data GophermapEntry = GophermapEntry GopherFileType ByteString- (Maybe FilePath) (Maybe ByteString) (Maybe Integer) -- ^ file type, description, path, server name, port number+ (Maybe GophermapFilePath) (Maybe ByteString) (Maybe Integer) -- ^ file type, description, path, server name, port number deriving (Show, Eq) type Gophermap = [GophermapEntry] --- | Attoparsec 'Parser' for the <https://raw.githubusercontent.com/sternenseemann/spacecookie/master/docs/gophermap-pygopherd.txt gophermap file format>+-- | Attoparsec 'Parser' for the gophermap file format parseGophermap :: Parser Gophermap-parseGophermap = many parseGophermapLine--if' :: Bool -> a -> a -> a-if' True a _ = a-if' False _ b = b+parseGophermap = many1 parseGophermapLine <* endOfInput gopherFileTypeChar :: Parser Word8 gopherFileTypeChar = satisfy (inClass fileTypeChars) parseGophermapLine :: Parser GophermapEntry-parseGophermapLine = emptyGophermapline <|>- regularGophermapline <|>- infoGophermapline <|>- gophermaplineWithoutFileTypeChar+parseGophermapLine = emptyGophermapline+ <|> regularGophermapline+ <|> infoGophermapline infoGophermapline :: Parser GophermapEntry infoGophermapline = do- text <- takeWhile (notInClass "\t\r\n")- endOfLine'+ text <- takeWhile1 (notInClass "\t\r\n")+ endOfLineOrInput return $ GophermapEntry InfoLine text Nothing@@ -91,47 +114,38 @@ regularGophermapline :: Parser GophermapEntry regularGophermapline = do- fileTypeChar <- gopherFileTypeChar- text <- itemValue- pathString <- optionalValue- host <- optionalValue- portString <- optionalValue- endOfLine'- return $ GophermapEntry (charToFileType fileTypeChar)- text- (santinizeIfNotUrl . fst . U.decode . unpack <$> pathString)- host- (byteStringToPort <$> portString)--emptyGophermapline :: Parser GophermapEntry-emptyGophermapline = do- endOfLine'- return emptyInfoLine- where emptyInfoLine = GophermapEntry InfoLine (pack []) Nothing Nothing Nothing--gophermaplineWithoutFileTypeChar :: Parser GophermapEntry-gophermaplineWithoutFileTypeChar = do+ fileTypeChar <- gopherFileTypeChar text <- itemValue- pathString <- optionalValue+ _ <- satisfy (inClass "\t")+ pathString <- option Nothing $ Just <$> itemValue host <- optionalValue portString <- optionalValue- endOfLine'- return $ GophermapEntry InfoLine+ endOfLineOrInput+ return $ GophermapEntry (charToFileType fileTypeChar) text- (santinizeIfNotUrl . fst . U.decode . unpack <$> pathString)+ (makeGophermapFilePath <$> pathString) host (byteStringToPort <$> portString) +emptyGophermapline :: Parser GophermapEntry+emptyGophermapline = do+ endOfLine'+ return emptyInfoLine+ where emptyInfoLine = GophermapEntry InfoLine (pack []) Nothing Nothing Nothing+ byteStringToPort :: ByteString -> Integer-byteStringToPort s = fromIntegral . read . fst . U.decode . unpack $ s+byteStringToPort s = read . fst . U.decode . unpack $ s optionalValue :: Parser (Maybe ByteString) optionalValue = option Nothing $ do- satisfy (inClass "\t")+ _ <- satisfy (inClass "\t") Just <$> itemValue itemValue :: Parser ByteString-itemValue = takeTill (inClass "\t\r\n")+itemValue = takeWhile1 (notInClass "\t\r\n") endOfLine' :: Parser () endOfLine' = (word8 10 >> return ()) <|> (string "\r\n" >> return ())++endOfLineOrInput :: Parser ()+endOfLineOrInput = endOfInput <|> endOfLine'
+ src/Network/Gopher/Util/Socket.hs view
@@ -0,0 +1,60 @@+-- | Internal socket utilities implementing missing+-- features of 'System.Socket' which are yet to be+-- upstreamed.+module Network.Gopher.Util.Socket+ ( gracefulClose+ ) where++import Control.Concurrent.MVar (withMVar)+import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (race)+import Control.Exception.Base (throwIO)+import Control.Monad (void, when)+import Data.Functor ((<&>))+import Foreign.C.Error (Errno (..), getErrno)+import Foreign.C.Types (CInt (..))+import System.Socket (receive, msgNoSignal, SocketException (..), close, Family ())+import System.Socket.Type.Stream (Stream ())+import System.Socket.Protocol.TCP (TCP ())+import System.Socket.Unsafe (Socket (..))++-- Until https://github.com/lpeterse/haskell-socket/pull/67 gets+-- merged, we have to implement shutdown ourselves.+foreign import ccall unsafe "shutdown"+ c_shutdown :: CInt -> CInt -> IO CInt++data ShutdownHow+ -- | Disallow Reading (calls to 'receive' are empty).+ = ShutdownRead+ -- | Disallow Writing (calls to 'send' throw).+ | ShutdownWrite+ -- | Disallow both.+ | ShutdownReadWrite+ deriving (Show, Eq, Ord, Enum)++-- | Shutdown a stream connection (partially).+-- Will send TCP FIN and prompt a client to+-- close the connection.+--+-- Not exposed to prevent future name clash.+shutdown :: Socket a Stream TCP -> ShutdownHow -> IO ()+shutdown (Socket mvar) how = withMVar mvar $ \fd -> do+ res <- c_shutdown (fromIntegral fd)+ $ fromIntegral $ fromEnum how+ when (res /= 0) $ throwIO =<<+ (getErrno <&> \(Errno errno) -> SocketException errno)++-- | Shutdown connection and give client a bit+-- of time to clean up on its end before closing+-- the connection to avoid a broken pipe on the+-- other side.+gracefulClose :: Family f => Socket f Stream TCP -> IO ()+gracefulClose sock = do+ -- send TCP FIN+ shutdown sock ShutdownWrite+ -- wait for some kind of read from the+ -- client (either mempty, meaning TCP FIN,+ -- something else which would mean protocol+ -- violation). Give up after 1s.+ _ <- race (void $ receive sock 16 msgNoSignal) (threadDelay 1000000)+ close sock
+ test/Main.hs view
@@ -0,0 +1,20 @@+module Main where++import Test.Tasty++-- library tests+import Test.Gophermap++-- server executable tests+import Test.FileTypeDetection+import Test.Integration++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests"+ [ gophermapTests+ , fileTypeDetectionTests+ , integrationTests+ ]
+ test/Test/FileTypeDetection.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+module Test.FileTypeDetection (fileTypeDetectionTests) where++import Network.Gopher (GopherFileType (..))+import Network.Spacecookie.FileType++import System.FilePath.Posix.ByteString (takeExtension)+import Test.Tasty+import Test.Tasty.HUnit++fileTypeDetectionTests :: TestTree+fileTypeDetectionTests = testGroup "spacecookie server file type detection"+ [ ioTests+ , suffixTests+ ]++ioTests :: TestTree+ioTests = testCase "gopherFileType tests" $ do+ assertEqual "Fallback to File without extension" (Right File)+ =<< gopherFileType "LICENSE"++ assertEqual "non-existent dot files are forbidden" (Left PathIsNotAllowed)+ =<< gopherFileType ".dot-file-missing"++ assertEqual "dot file along the path" (Left PathIsNotAllowed)+ =<< gopherFileType ".git/HEAD"++ assertEqual "dot file along the path" (Left PathIsNotAllowed)+ =<< gopherFileType "./foo/.git/HEAD"++ assertEqual ".. is disallowed" (Left PathIsNotAllowed)+ =<< gopherFileType "/lol/../../doing/directory/traversal.txt"++ assertEqual "\".\" is allowed" (Right Directory)+ =<< gopherFileType "."++ assertEqual "txt files" (Right File)+ =<< gopherFileType "./docs/rfc1436.txt"++ assertEqual "missing file" (Left PathDoesNotExist)+ =<< gopherFileType "missing/this.txt"++suffixTests :: TestTree+suffixTests = testCase "correct mapping of suffixes" $ do+ assertEqual "BinHexMacintoshFile" BinHexMacintoshFile $+ lookupSuffix $ takeExtension "test.hqx"++ assertEqual "tar.gz is BinaryFile" BinaryFile $+ lookupSuffix $ takeExtension "/releases/spacecookie-0.3.0.0.tar.gz"++ assertEqual "gif file" GifFile $+ lookupSuffix $ takeExtension "funny.gif"++ mapM_ (assertEqual "image file" ImageFile . lookupSuffix . takeExtension)+ [ "hello.png", "/my/beautiful.jpg", "./../lol.jpeg"+ , "../bar.tif", "my.tiff", ".hidden.svg", "my.bmp" ]++ assertEqual "fallback to File" File $+ lookupSuffix $ takeExtension "my/unknown.strange-extension"
+ test/Test/Gophermap.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+module Test.Gophermap (gophermapTests) where++import Control.Monad (forM_)+import Data.Attoparsec.ByteString (parseOnly)+import qualified Data.ByteString as B+import Data.Either+import Network.Gopher (GopherFileType (..))+import Network.Gopher.Util (stripNewline)+import Network.Gopher.Util.Gophermap+import System.FilePath.Posix.ByteString (RawFilePath)+import Test.Tasty+import Test.Tasty.HUnit++withFileContents :: FilePath -> (IO B.ByteString -> TestTree) -> TestTree+withFileContents path = withResource (B.readFile path) (const (pure ()))++gophermapTests :: TestTree+gophermapTests = testGroup "gophermap tests"+ [ withFileContents "test/data/pygopherd.gophermap" checkPygopherd+ , withFileContents "test/data/bucktooth.gophermap" checkBucktooth+ , generalGophermapParsing+ ]++checkPygopherd :: IO B.ByteString -> TestTree+checkPygopherd file = testCase "pygopherd example gophermap" $+ file >>= assertEqual "" (Right expectedPygopherd) . parseOnly parseGophermap++infoLine :: B.ByteString -> GophermapEntry+infoLine b = GophermapEntry InfoLine b Nothing Nothing Nothing++absDir :: B.ByteString -> RawFilePath -> B.ByteString -> GophermapEntry+absDir n p s =+ GophermapEntry Directory n (Just (GophermapAbsolute p)) (Just s) $ Just 70++expectedPygopherd :: Gophermap+expectedPygopherd =+ [ infoLine "Welcome to Pygopherd! You can place your documents"+ , infoLine "in /var/gopher for future use. You can remove the gophermap"+ , infoLine "file there to get rid of this message, or you can edit it to"+ , infoLine "use other things. (You'll need to do at least one of these"+ , infoLine "two things in order to get your own data to show up!)"+ , infoLine ""+ , infoLine "Some links to get you started:"+ , infoLine ""+ , absDir "Pygopherd Home" "/devel/gopher/pygopherd" "gopher.quux.org"+ , absDir "Quux.Org Mega Server" "/" "gopher.quux.org"+ , absDir "The Gopher Project" "/Software/Gopher" "gopher.quux.org"+ , absDir "Traditional UMN Home Gopher" "/" "gopher.tc.umn.edu"+ , infoLine ""+ , infoLine "Welcome to the world of Gopher and enjoy!"+ ]++checkBucktooth :: IO B.ByteString -> TestTree+checkBucktooth file = testCase "bucktooth example gophermap" $ do+ parseResult <- parseOnly parseGophermap <$> file++ assertBool "no parse failure" $ isRight parseResult++ -- check if we can distinguish between text/infolines and+ -- gophermap lines which have no path+ assertEqual "overbite link is parsed correctly" [expectedOverbiteEntry]+ . filter (\(GophermapEntry _ n _ _ _) -> n == "/overbite")+ $ fromRight [] parseResult++ assertEqual "correct length" 95 . length $ fromRight [] parseResult++expectedOverbiteEntry :: GophermapEntry+expectedOverbiteEntry =+ GophermapEntry Directory "/overbite" Nothing Nothing Nothing++generalGophermapParsing :: TestTree+generalGophermapParsing = testGroup "gophermap entry test cases" $+ let lineEqual :: B.ByteString -> GophermapEntry -> Assertion+ lineEqual b e = assertEqual (show b) (Right [e]) $+ parseOnly parseGophermap b+ infoLines =+ [ "1. beginning with valid file type\n"+ , "just some usual text.\n"+ , "ends with end of input"+ , "i'm blue"+ , "0"+ , "empty ones need to be terminated by a new line\n"+ , "\n"+ , "otherwise parsing doesn't make sense anymore"+ , "DOS-style newlines are also allowed\r\n"+ ]+ menuEntry t name path =+ GophermapEntry t name (Just path) Nothing Nothing+ menuLines =+ [ ("1/somedir\t", GophermapEntry Directory "/somedir" Nothing Nothing Nothing)+ , ("0file\tfile.txt\n", menuEntry File "file" (GophermapRelative "file.txt"))+ , ("ggif\t/pic.gif", menuEntry GifFile "gif" (GophermapAbsolute "/pic.gif"))+ , ("hcode\tURL:https://code.sterni.lv\n", menuEntry Html "code" (GophermapUrl "URL:https://code.sterni.lv"))+ , ("1foo\tfoo\tsterni.lv", GophermapEntry Directory "foo" (Just $ GophermapRelative "foo") (Just "sterni.lv") Nothing)+ , ("Ibar\t/bar.png\tsterni.lv\t7070\n", GophermapEntry ImageFile "bar" (Just $ GophermapAbsolute "/bar.png") (Just "sterni.lv") (Just 7070))+ , ("imanual info line\t", infoLine "manual info line")+ ]+ in [ testCase "info lines" $ forM_ infoLines (\l -> lineEqual l $ infoLine (stripNewline l))+ , testCase "menu entries" $ forM_ menuLines (uncurry lineEqual) ]
+ test/Test/Integration.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings #-}+module Test.Integration where++import Control.Applicative ((<|>))+import Control.Concurrent (threadDelay)+import Control.Exception (bracket)+import Control.Monad (forM_)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.List+import Data.Maybe (isNothing, isJust, fromJust)+import Network.Curl.Download (openURI)+import Network.Gopher.Util (asciiOrd)+import System.Directory (findExecutable)+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.Process (spawnProcess, terminateProcess, waitForProcess)+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit+import Test.Tasty.Providers (testPassed)+import Test.Tasty.Runners (Result (..))++spacecookieBin :: IO (Maybe FilePath)+spacecookieBin = do+ fromEnv <- lookupEnv "SPACECOOKIE_TEST_BIN"+ fromPath <- findExecutable "spacecookie"+ pure $ fromEnv <|> fromPath++ignoreTestIf :: IO Bool -> String -> TestTree -> TestTree+ignoreTestIf doSkip msg tree = wrapTest change tree+ where change normal = do+ skip <- doSkip+ if not skip+ then normal+ else pure $ (testPassed msg) {+ resultShortDescription = "SKIP"+ }++integrationTests :: TestTree+integrationTests = testGroup "integration tests"+ [ ignoreTestIf (isNothing <$> spacecookieBin) "no spacecookie executable"+ $ testCaseSteps "spacecookie server behaves as expected" integrationAsserts+ ]++integrationAsserts :: (String -> IO ()) -> Assertion+integrationAsserts step = do+ step "getting spacecookie executable"+ bin <- spacecookieBin+ assertBool "have spacecookie executable" $ isJust bin+ step "starting spacecookie executable"+ bracket (spawn (fromJust bin)) assertSuccess+ $ const $ do+ threadDelay 1000000 -- wait 1 sec for the server to start up+ step "request root menu"++ assertEqual "root menu as expected" (Right expectedRoot)+ =<< openURI "gopher://localhost:7000/0"++ assertEqual "root menu requested with / as expected" (Right expectedRoot)+ =<< openURI "gopher://localhost:7000/0/"++ step "request plain.txt"++ fileDisk <- Right <$> B.readFile "test/integration/root/plain.txt"+ fileGopher <- openURI "gopher://localhost:7000/1/plain.txt"++ assertEqual "served file is same as on disk" fileDisk fileGopher++ step "check automatically generated directory menus"++ dir <- openURI "gopher://localhost:7000/0/dir"+ dirNoSlash <- openURI "gopher://localhost:7000/0dir"++ assertEqual "directory menu is equal regardless of request" dir dirNoSlash++ -- ignore ordering for the purpose of this test+ assertEqual "directory menu contains expected entries" (Right expectedDir)+ $ sort . filter (not . B.null) . B.split (asciiOrd '\n') <$> dir++ step "sanity check not found error messages"++ notFoundError <- openURI "gopher://localhost:7000/1/does/not/exist"+ anotherNotFoundError <- openURI "gopher://localhost:7000/0/not-here.txt"+ urlNotFoundError <- openURI "gopher://localhost:7000/0URL:http://sterni.lv"++ assertEqual "precise error message"+ (Right expectedErrorMessage) anotherNotFoundError++ forM_ [ notFoundError, anotherNotFoundError, urlNotFoundError ]+ $ assertIsError++ assertBool "error responses differ for different files"+ $ notFoundError /= anotherNotFoundError++ assertBool "error response for URL: selectors is helpful"+ $ Right True == fmap (B.isInfixOf "support") urlNotFoundError++ step "sanity check not allowed error messages"++ -- can't test directory traversal since curl won't try it+ accessGophermap <- openURI "gopher://localhost:7000/0/.gophermap"+ accessNonExistentDot <- openURI "gopher://localhost:7000/0/dir/.not-here"++ forM_ [ accessGophermap, accessNonExistentDot ] $ \err -> do+ assertIsError err+ assertBool "error response is not allowed response"+ $ Right True == fmap (B.isInfixOf "allow") err++ where spawn bin = spawnProcess bin [ "test/integration/spacecookie.json" ]+ assertSuccess hdl = do+ step "stopping spacecookie"+ terminateProcess hdl+ assertEqual "spacecookie's exit code indicates SIGTERM" (ExitFailure (-15))+ =<< waitForProcess hdl+ assertIsError e = assertEqual "error response starts with a 3" (Right "3")+ $ fmap (B.take 1) e++expectedRoot :: ByteString+expectedRoot = mconcat+ [ "iHello World!\tHello World!\tlocalhost\t7000\r\n"+ , "i\t\tlocalhost\t7000\r\n"+ , "0normal text file\t/plain.txt\tlocalhost\t7000\r\n"+ , "1normal dir\t/dir\tlocalhost\t7000\r\n"+ , "i\t\tlocalhost\t7000\r\n"+ , "1external\t/\tsterni.lv\t7000\r\n"+ ]++expectedDir :: [ByteString]+expectedDir = sort+ [ "1another\t/dir/another\tlocalhost\t7000\r"+ , "0mystery-file\t/dir/mystery-file\tlocalhost\t7000\r"+ , "4macintosh.hqx\t/dir/macintosh.hqx\tlocalhost\t7000\r"+ ]++expectedErrorMessage :: ByteString+expectedErrorMessage = mconcat+ [ "3The requested resource '/not-here.txt' does not exist"+ , " or is not available.\tErr\tlocalhost\t7000\r\n" ]
+ test/data/bucktooth.gophermap view
@@ -0,0 +1,95 @@+Welcome to Floodgap Systems' official gopher server.+Floodgap has served the gopher community since 1999+(formerly gopher.ptloma.edu). ** OVER A DECADE OF SERVICE! **++We run Bucktooth 0.2.8 on xinetd as our server system.+gopher.floodgap.com is an IBM Power 520 Express with a 2-way+4.2GHz POWER6 CPU and 8GB of RAM, running AIX 6.1 TL6.+Send gopher@floodgap.com your questions and suggestions.++THIS IS A NEW SERVER -- bugs are to be expected.+E-mail weird behaviour to us. 4/2011++***********************************************************+** CELEBRATING GOPHER'S 20 YEAR ANNIVERSARY! **+** Plain text is beautiful! **+***********************************************************++0Does this gopher menu look correct? /gopher/proxy+(plus using the Floodgap Public Gopher Proxy)+1Super-Dimensional Fortress: SDF Gopherspace sdf.org 70+Get your own Gopherspace and shell account!++--- Getting started with Gopher -----------------------------------+1Getting started with gopher, software, more /gopher+(what is Gopherspace? We tell you! And find out how+to create your own Gopher world!)++0Using web browsers in Gopherspace /gopher/wbgopher+(READ IT! LEARN IT! LOVE IT!)+(useful tips for gopher newbies, updated 11 November 2010)++1/overbite +(download gopher add-ons for Mozilla Firefox, Google Chrome,+mobile clients for Android and more! Put Gopherspace on+your mobile phone or desktop computer!)+1Other Gopher clients for various platforms /gopher/clients++--- Find and search for other Gopher sites on the Internet --------+1Search Gopherspace with Veronica-2 and VISHNU /v2+or search all known titles in Gopherspace with Veronica-2 here:+7Search Veronica-2 /v2/vs++1All the gopher servers in the world (that we know of) /world+(updated with robot updates)+1New Gopher servers since 1999 /new+(updated 25 April 2011)++--- Get news, weather and more through Gopherspace ----------------+1Weather maps and forecasts via Floodgap Groundhog /groundhog+(updates occur throughout the day)+1News and headline feeds via Flood Feeds /feeds+(updates occur daily/regularly)+1Most current Floodgap news feeds /feeds/latest+(today's most updated news and headlines)+0United States Geological Survey earthquake list /quakes+(up to date USGS earthquake information for all states w/AK, HI, PR+ and selected international locations)+(updated on access)+0Caltrans California highway conditions /calroads+(hourly updates on California highway conditions)+(updated on access)++--- File archives and downloads -----------------------------------+1Floodgap File Archives and Mirrors /archive+(includes external archives and historical files,+Walnut Creek CP/M-Osborne-Commodore-Beehive archives,+Info-Mac, classic Mac software and more)++--- Fun, games, and other neat things -----------------------------+1Floodgap Gopher Fun and Games /fun+(with xkcd, Hitori Dake no Renga, the Gopher Figlet gateway+and Twitpher, the Twitter->gopher interface)+1Floodgap users and staff gopher pages /users+(the usual gang of idiots)+1The New GopherVR: A Virtual Reality View of Gopherspace /gophervr+(version 0.4.1 released 10 September 2010)++--- Server software behind the scenes -----------------------------+1The Bucktooth gopher server /buck+(version 0.2.8 released 23 June 2010)++--- Gopherspace advocacy and activism -----------------------------+1Floodgap Gopher Statistics Project /gstats+(monthly traffic analysis of the Floodgap Public Gopher Proxy+for community advocacy purposes; updates monthly)++1The Floodgap Free Software License /ffsl+0Where's Floodgap? (not for hatemail ;-) /whereis+0"/usr/bin/tail" our gopher server log /recent+0RIP, Master gopher at University of Minnesota umngone+hFloodgap.com (Web pages) URL:http://www.floodgap.com/++Please note that this gopher is now an independent+entity and is no longer affiliated with Point Loma+Nazarene University.
+ test/data/pygopherd.gophermap view
@@ -0,0 +1,14 @@+Welcome to Pygopherd! You can place your documents+in /var/gopher for future use. You can remove the gophermap+file there to get rid of this message, or you can edit it to+use other things. (You'll need to do at least one of these+two things in order to get your own data to show up!)++Some links to get you started:++1Pygopherd Home /devel/gopher/pygopherd gopher.quux.org 70+1Quux.Org Mega Server / gopher.quux.org 70+1The Gopher Project /Software/Gopher gopher.quux.org 70+1Traditional UMN Home Gopher / gopher.tc.umn.edu 70++Welcome to the world of Gopher and enjoy!
+ test/integration/root/.gophermap view
@@ -0,0 +1,6 @@+Hello World!++0normal text file plain.txt+1normal dir dir++1external / sterni.lv
+ test/integration/root/dir/another/.git-hello view
+ test/integration/root/dir/macintosh.hqx view
+ test/integration/root/dir/mystery-file view
+ test/integration/root/plain.txt view
@@ -0,0 +1,35 @@+Es ist eine natürliche Vorstellung, daß, ehe in der Philosophie an die Sache selbst, nämlich+an das wirkliche Erkennen dessen, was in Wahrheit ist, gegangen wird, es notwendig sei, vorher+über das Erkennen sich zu verständigen, das als das Werkzeug, wodurch man des Absoluten+sich bemächtige, oder als das Mittel, durch welches hindurch man es erblicke, betrachtet+wird. Die Besorgnis scheint gerecht, teils, daß es verschiedene Arten der Erkenntnis geben+und darunter eine geschickter als eine andere zur Erreichung dieses Endzwecks sein möchte,+hiermit auch falsche Wahl unter ihnen, – teils auch daß, indem das Erkennen ein Vermögen+von bestimmter Art und Umfange ist, ohne die genauere Bestimmung seiner Natur und Grenze+Wolken des Irrtums statt des Himmels der Wahrheit erfaßt werden. Diese Besorgnis muß sich+wohl sogar in die Überzeugung verwandeln, daß das ganze Beginnen, dasjenige, was an sich+ist, durch das Erkennen dem Bewußtsein zu erwerben, in seinem Begriffe widersinnig sei, und+zwischen das Erkennen und das Absolute eine sie schlechthin scheidende Grenze falle. Denn ist+das Erkennen das Werkzeug, sich des absoluten Wesens zu bemächtigen, so fällt sogleich auf,+daß die Anwendung eines Werkzeugs auf eine Sache sie vielmehr nicht läßt, wie sie für sich+ist, sondern eine Formierung und Veränderung mit ihr vornimmt. Oder ist das Erkennen nicht+Werkzeug unserer Tätigkeit, sondern gewissermaßen ein passives Medium, durch welches hindurch+das Licht der Wahrheit an uns gelangt, so erhalten wir auch so sie nicht, wie sie an sich,+sondern wie sie durch und in diesem Medium ist. Wir gebrauchen in beiden Fällen ein Mittel,+welches unmittelbar das Gegenteil seines Zwecks hervorbringt; oder das Widersinnige ist vielmehr,+daß wir uns überhaupt eines Mittels bedienen. Es scheint zwar, daß diesem Übelstande durch die+Kenntnis der Wirkungsweise des Werkzeugs abzuhelfen steht, denn sie macht es möglich, den Teil,+welcher in der Vorstellung, die wir durch es vom Absoluten erhalten, dem Werkzeuge angehört, im+Resultate abzuziehen und so das Wahre rein zu erhalten. Allein diese Verbesserung würde uns in+der Tat nur dahin zurückbringen, wo wir vorher waren. Wenn wir von einem formierten Dinge das+wieder wegnehmen, was das Werkzeug daran getan hat, so ist uns das Ding – hier das Absolute+– gerade wieder soviel als vor dieser somit überflüssigen Bemühung. Sollte das Absolute+durch das Werkzeug uns nur überhaupt nähergebracht werden, ohne etwas an ihm zu verändern,+wie etwa durch die Leimrute der Vogel, so würde es wohl, wenn es nicht an und für sich schon+bei uns wäre und sein wollte, dieser List spotten; denn eine List wäre in diesem Falle das+Erkennen, da es durch sein vielfaches Bemühen ganz etwas anderes zu treiben sich die Miene gibt,+als nur die unmittelbare und somit mühelose Beziehung hervorzubringen. Oder wenn die Prüfung+des Erkennens, das wir als ein Medium uns vorstellen, uns das Gesetz seiner Strahlenbrechung+kennen lehrt, so nützt es ebenso nichts, sie im Resultate abzuziehen; denn nicht das Brechen+des Strahls, sondern der Strahl selbst, wodurch die Wahrheit uns berührt, ist das Erkennen,+und dieses abgezogen, wäre uns nur die reine Richtung oder der leere Ort bezeichnet worden.
+ test/integration/spacecookie.json view
@@ -0,0 +1,12 @@+{+ "hostname" : "localhost",+ "listen" : {+ "addr" : "::",+ "port" : 7000+ },+ "user" : null,+ "root" : "./test/integration/root",+ "log" : {+ "enable" : false+ }+}