(ns terraboot.elasticsearch
  (:require [terraboot.core :refer :all]
            [terraboot.utils :refer :all]
            [terraboot.cloud-config :refer [cloud-config]]
            [cheshire.core :as json]
            [clojure.string :as str]
            [clojure.core.strint :refer [<<]]))

(def stop-update-engine {:name "update-engine.service"
                         :command "stop"})

(def stop-locksmithd {:name "locksmithd.service"
                      :command "stop"})

(def common-coreos-units [stop-update-engine
                          stop-locksmithd])

(defn docker-systemd-unit
  ([org-name image-name] (docker-systemd-unit org-name image-name {}))
  ([org-name image-name {options :options
                         entry-point :entry-point
                         release :release
                         :or {options []
                              entry-point ""
                              release "latest"}}]
   (let [option-string (str/join " " options)
         full-image-name (str org-name "/" image-name)]
     {:name (str image-name ".service")
      :command "start"
      :enable true
      :content (<<
                "[Unit]
Description=~{image-name}
After=docker.service
Requires=docker.service

[Service]
Slice=machine.slice
TimeoutSec=600
ExecStartPre=/usr/bin/docker pull ~{full-image-name}:~{release}
ExecStartPre=-/usr/bin/docker kill ~{image-name}
ExecStartPre=-/usr/bin/docker rm ~{image-name}
ExecStart=/usr/bin/docker run --name ~{image-name} ~{option-string} ~{full-image-name}:~{release} ~{entry-point}
ExecStop=/usr/bin/docker stop ~{image-name}

[Install]
WantedBy=multi-user.target")})))

(defn cloud-config-coreos [units]
  (cloud-config {:coreos {:update
                          {:reboot-strategy "off"}
                          :units (concat common-coreos-units
                                         units)
                          }}))

(defn logstash-user-data-coreos [es-endpoint]
  (let [logstash (docker-systemd-unit "mastodonc" "logstash-ng"
                                      {:options [(str "--env " "ES_HOST=" es-endpoint)
                                                 "--net=host"]
                                       :entry-point "-f /etc/logstash/logstash.conf"})
        nginx (docker-systemd-unit "mastodonc" "kibana-nginx"
                                   {:options [(str "--env " "ES_HOST=" es-endpoint)
                                              "--net=host"]})
        ]
    (cloud-config-coreos [logstash
                          nginx])))

(defn elasticsearch-policy
  []
  (json/generate-string {"Version" "2012-10-17",
                         "Statement" [{"Action" "es:*",
                                       "Principal" "*",
                                       "Resource" "$${es-arn}",
                                       ;; There is currently a bug which means 'Resource' needs adding after the
                                       ;; cluster is created or it will constantly say it needs to change.
                                       ;; https://github.com/hashicorp/terraform/issues/5067
                                       "Effect" "Allow",
                                       "Condition"
                                       {
                                        "IpAddress"
                                        {"aws:SourceIp" ["$${allowed-ips}"]}}}]}))

(defn elasticsearch-cluster [name {:keys [es-endpoint vpc-name account-number region azs default-ami mesos-ami vpc-cidr-block cert-name key-name] :as spec}]
  ;; http://docs.aws.amazon.com/elasticsearch-service/latest/developerguide/es-createupdatedomains.html#es-createdomain-configure-ebs
  ;; See for what instance-types and storage is possible
  (let [vpc-unique (vpc-unique-fn vpc-name)
        vpc-resource (partial resource vpc-unique)
        vpc-id-of (id-of-fn vpc-unique)
        vpc-output-of (output-of-fn vpc-unique)
        vpc-security-group (partial scoped-security-group vpc-unique)
        elb-listener (account-elb-listener account-number)
        es-arn (str "arn:aws:es:" region ":" account-number ":domain/" name)
        es-arn-* (str es-arn "/*")]

    (merge-in
     (template-file (vpc-unique "elasticsearch-policy")
                    (elasticsearch-policy)
                    {:es-arn es-arn-*
                     :allowed-ips  (vpc-output-of "aws_eip" "logstash" "public_ip")})

     (resource "aws_elasticsearch_domain" name
               {:domain_name name
                :elasticsearch_version "5.1"
                :advanced_options { "rest.action.multi.allow_explicit_index" "true"}
                :access_policies (rendered-template-file (vpc-unique "elasticsearch-policy"))
                :cluster_config {:instance_count 2,
                                 :instance_type "m4.large.elasticsearch"}
                :ebs_options {:ebs_enabled true,
                              :volume_type "gp2",
                              :volume_size 100
                              },
                :snapshot_options { :automated_snapshot_start_hour 23}})

     (vpc-resource "aws_iam_role" "logstash" {:name "logstash"
                                              :assume_role_policy (json/generate-string {
                                                                                "Version" "2012-10-17",
                                                                                "Statement" [
                                                                                {
                                                                                "Action" "sts:AssumeRole",
                                                                                "Principal" {
                                                                                "Service" "ec2.amazonaws.com"
                                                                                },
                                                                                "Effect" "Allow",
                                                                                "Sid" ""}]})})

     (vpc-resource "aws_iam_role_policy" "logstash"
                   {"name" "logstash"
                    "role"  (vpc-id-of "aws_iam_role" "logstash")
                    "policy" (json/generate-string {
                                                    "Version" "2012-10-17"
                                                    "Statement" [{
                                                                  "Resource" es-arn-*,
                                                                  "Action" ["es:*"],
                                                                  "Effect" "Allow"
                                                                  }
                                                                 {
                                                                  "Resource" es-arn,
                                                                  "Action" ["es:*"],
                                                                  "Effect" "Allow"
                                                                  }
                                                                 ]})})

     (vpc-resource "aws_iam_instance_profile" "logstash" {
                                                          :name "logstash"
                                                          :roles  [(vpc-output-of "aws_iam_role" "logstash" "name")]
                                                          })

     (add-key-name-to-instances
      key-name
      (in-vpc (id-of "aws_vpc" vpc-name)
              (vpc-security-group "logstash" {}
                                  {:port 12201
                                   :protocol "udp"
                                   :source_security_group_id (vpc-id-of "aws_security_group" "sends_gelf")}
                                  {:port 12201
                                   :protocol "udp"
                                   :cidr_blocks (mapv #(str (vpc-output-of "aws_eip" (stringify "public-" % "-nat") "public_ip") "/32") azs)}
                                  {:port 12201
                                   :protocol "udp"
                                   :cidr_blocks [vpc-cidr-block]}
                                  {:port 9200
                                   :protocol "tcp"
                                   :cidr_blocks [vpc-cidr-block]})

              (vpc-resource "aws_eip" "logstash"
                            {:vpc true
                             :instance (vpc-id-of "aws_instance" "logstash")})

              (vpc-security-group "sends_gelf" {})

              (vpc-security-group "sends_logstash" {})

              (aws-instance (vpc-unique "logstash") {:ami mesos-ami
                                                     :instance_type "m4.large"
                                                     :vpc_security_group_ids [(vpc-id-of "aws_security_group" "logstash")
                                                                              (id-of "aws_security_group" "allow_ssh")
                                                                              (vpc-id-of "aws_security_group" "sends_influx")
                                                                              (vpc-id-of "aws_security_group" "all-servers")
                                                                              (vpc-id-of "aws_security_group" "elb-kibana")
                                                                              ]
                                                     :user_data (logstash-user-data-coreos es-endpoint)
                                                     :associate_public_ip_address true
                                                     :subnet_id (vpc-id-of "aws_subnet" "public-a")
                                                     :iam_instance_profile (vpc-id-of "aws_iam_instance_profile" "logstash")})

              ;; alerting server needs access to all servers
              (vpc-security-group "nrpe" {})

              (database {:name (vpc-unique "alerts")
                         :subnet vpc-name})

              (aws-instance (vpc-unique "alerts")
                            {:ami default-ami
                             :subnet_id (vpc-id-of "aws_subnet" "private-a")
                             :vpc_security_group_ids [(vpc-id-of "aws_security_group" "nrpe")
                                                      (id-of "aws_security_group" (str "uses-db-" (vpc-unique "alerts")))
                                                      (vpc-id-of "aws_security_group" "allow-elb-alerts")
                                                      (vpc-id-of "aws_security_group" "all-servers")
                                                      (vpc-id-of "aws_security_group" "sends_influx")]})

              (elb "alerts" resource {:name "alerts"
                                      :health_check {:healthy_threshold 2
                                                     :unhealthy_threshold 3
                                                     :target "HTTP:80/"
                                                     :timeout 5
                                                     :interval 30}
                                      :listener [(elb-listener (if cert-name
                                                                  {:lb-port 443 :lb-protocol "https" :port 80 :protocol "http" :cert-name cert-name}
                                                                  {:port 80 :protocol "http"}))]
                                      :subnets (mapv #(id-of "aws_subnet" (stringify  vpc-name "-public-" %)) azs)
                                      :instances [(id-of "aws_instance" (vpc-unique "alerts"))]
                                      :security_groups (map #(id-of "aws_security_group" %)
                                                            ["allow_outbound"
                                                             "allow_external_http_https"
                                                             (vpc-unique "elb-alerts")
                                                             ])})

              (vpc-security-group "elb-alerts" {})
              (vpc-security-group "allow-elb-alerts" {}
                                  {:port 80
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-alerts")})

              (vpc-security-group "elb-kibana" {}
                                  {:port 80
                                   :cidr_blocks [vpc-cidr-block]}
                                  {:port 443
                                   :cidr_blocks [vpc-cidr-block]})
              (vpc-security-group "allow-elb-kibana" {}
                                  {:port 80
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-kibana")}
                                  {:port 443
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-kibana")})
              (vpc-security-group  "kibana" {}
                                   {:type "egress"
                                    :from_port 0
                                    :to_port 0
                                    :protocol -1
                                    :cidr_blocks [all-external]})

              )))))

(ns terraboot.elasticsearch
  (:require [terraboot.core :refer :all]
            [terraboot.utils :refer :all]
            [terraboot.cloud-config :refer [cloud-config]]
            [cheshire.core :as json]
            [clojure.string :as str]
            [clojure.core.strint :refer [<<]]))

(def stop-update-engine {:name "update-engine.service"
                         :command "stop"})

(def stop-locksmithd {:name "locksmithd.service"
                      :command "stop"})

(def common-coreos-units [stop-update-engine
                          stop-locksmithd])

(defn docker-systemd-unit
  ([org-name image-name] (docker-systemd-unit org-name image-name {}))
  ([org-name image-name {options :options
                         entry-point :entry-point
                         release :release
                         :or {options []
                              entry-point ""
                              release "latest"}}]
   (let [option-string (str/join " " options)
         full-image-name (str org-name "/" image-name)]
     {:name (str image-name ".service")
      :command "start"
      :enable true
      :content (<<
                "[Unit]
Description=~{image-name}
After=docker.service
Requires=docker.service

[Service]
Slice=machine.slice
TimeoutSec=600
ExecStartPre=/usr/bin/docker pull ~{full-image-name}:~{release}
ExecStartPre=-/usr/bin/docker kill ~{image-name}
ExecStartPre=-/usr/bin/docker rm ~{image-name}
ExecStart=/usr/bin/docker run --name ~{image-name} ~{option-string} ~{full-image-name}:~{release} ~{entry-point}
ExecStop=/usr/bin/docker stop ~{image-name}

[Install]
WantedBy=multi-user.target")})))

(defn cloud-config-coreos [units]
  (cloud-config {:coreos {:update
                          {:reboot-strategy "off"}
                          :units (concat common-coreos-units
                                         units)
                          }}))

(defn logstash-user-data-coreos [es-endpoint]
  (let [logstash (docker-systemd-unit "mastodonc" "logstash-ng"
                                      {:options [(str "--env " "ES_HOST=" es-endpoint)
                                                 "--net=host"]
                                       :entry-point "-f /etc/logstash/logstash.conf"})
        nginx (docker-systemd-unit "mastodonc" "kibana-nginx"
                                   {:options [(str "--env " "ES_HOST=" es-endpoint)
                                              "--net=host"]})
        ]
    (cloud-config-coreos [logstash
                          nginx])))

(defn elasticsearch-policy
  [iam-root es-arn-*]
  (json/generate-string
   {
    "Statement" [
                 {
                  "Action" "es:*"
                  "Effect" "Allow"
                  "Principal" {
                                 "AWS" iam-root
                                 }
                   "Resource" es-arn-*}]
    "Version" "2012-10-17"}))

(defn elasticsearch-cluster [name {:keys [es-endpoint vpc-name account-number region azs default-ami mesos-ami vpc-cidr-block cert-name key-name] :as spec}]
  ;; http://docs.aws.amazon.com/elasticsearch-service/latest/developerguide/es-createupdatedomains.html#es-createdomain-configure-ebs
  ;; See for what instance-types and storage is possible
  (let [vpc-unique (vpc-unique-fn vpc-name)
        vpc-resource (partial resource vpc-unique)
        vpc-id-of (id-of-fn vpc-unique)
        vpc-output-of (output-of-fn vpc-unique)
        vpc-security-group (partial scoped-security-group vpc-unique)
        elb-listener (account-elb-listener account-number)
        es-arn (str "arn:aws:es:" region ":" account-number ":domain/" name)
        iam-root (str "arn:aws:iam::" account-number ":root")
        es-arn-* (str es-arn "/*")]

    (merge-in
     (template-file (vpc-unique "elasticsearch-policy")
                    (elasticsearch-policy iam-root es-arn-*)
                    {:es-arn es-arn-*
                     :allowed-ips  (vpc-output-of "aws_eip" "logstash" "public_ip")})

     (resource "aws_elasticsearch_domain" name
               {:domain_name name
                :elasticsearch_version "5.1"
                :advanced_options { "rest.action.multi.allow_explicit_index" "true"}
                :access_policies (rendered-template-file (vpc-unique "elasticsearch-policy"))
                :cluster_config {:instance_count 2,
                                 :instance_type "m4.large.elasticsearch"}
                :ebs_options {:ebs_enabled true,
                              :volume_type "gp2",
                              :volume_size 100
                              },
                :snapshot_options { :automated_snapshot_start_hour 23}})

     (vpc-resource "aws_iam_role" "logstash" {:name "logstash"
                                              :assume_role_policy (json/generate-string {
                                                                                "Version" "2012-10-17",
                                                                                "Statement" [
                                                                                {
                                                                                "Action" "sts:AssumeRole",
                                                                                "Principal" {
                                                                                "Service" "ec2.amazonaws.com"
                                                                                },
                                                                                "Effect" "Allow",
                                                                                "Sid" ""}]})})

     (vpc-resource "aws_iam_role_policy" "logstash"
                   {"name" "logstash"
                    "role"  (vpc-id-of "aws_iam_role" "logstash")
                    "policy" (json/generate-string {
                                                    "Version" "2012-10-17"
                                                    "Statement" [{
                                                                  "Resource" es-arn-*,
                                                                  "Action" ["es:*"],
                                                                  "Effect" "Allow"
                                                                  }
                                                                 {
                                                                  "Resource" es-arn,
                                                                  "Action" ["es:*"],
                                                                  "Effect" "Allow"
                                                                  }
                                                                 ]})})

     (vpc-resource "aws_iam_instance_profile" "logstash" {
                                                          :name "logstash"
                                                          :roles  [(vpc-output-of "aws_iam_role" "logstash" "name")]
                                                          })

     (add-key-name-to-instances
      key-name
      (in-vpc (id-of "aws_vpc" vpc-name)
              (vpc-security-group "logstash" {}
                                  {:port 12201
                                   :protocol "udp"
                                   :source_security_group_id (vpc-id-of "aws_security_group" "sends_gelf")}
                                  {:port 12201
                                   :protocol "udp"
                                   :cidr_blocks (mapv #(str (vpc-output-of "aws_eip" (stringify "public-" % "-nat") "public_ip") "/32") azs)}
                                  {:port 12201
                                   :protocol "udp"
                                   :cidr_blocks [vpc-cidr-block]}
                                  {:port 9200
                                   :protocol "tcp"
                                   :cidr_blocks [vpc-cidr-block]})

              (vpc-resource "aws_eip" "logstash"
                            {:vpc true
                             :instance (vpc-id-of "aws_instance" "logstash")})

              (vpc-security-group "sends_gelf" {})

              (vpc-security-group "sends_logstash" {})

              (aws-instance (vpc-unique "logstash") {:ami mesos-ami
                                                     :instance_type "m4.large"
                                                     :vpc_security_group_ids [(vpc-id-of "aws_security_group" "logstash")
                                                                              (id-of "aws_security_group" "allow_ssh")
                                                                              (vpc-id-of "aws_security_group" "sends_influx")
                                                                              (vpc-id-of "aws_security_group" "all-servers")
                                                                              (vpc-id-of "aws_security_group" "elb-kibana")
                                                                              ]
                                                     :user_data (logstash-user-data-coreos es-endpoint)
                                                     :associate_public_ip_address true
                                                     :subnet_id (vpc-id-of "aws_subnet" "public-a")
                                                     :iam_instance_profile (vpc-id-of "aws_iam_instance_profile" "logstash")})

              ;; alerting server needs access to all servers
              (vpc-security-group "nrpe" {})

              (database {:name (vpc-unique "alerts")
                         :subnet vpc-name})

              (aws-instance (vpc-unique "alerts")
                            {:ami default-ami
                             :subnet_id (vpc-id-of "aws_subnet" "private-a")
                             :vpc_security_group_ids [(vpc-id-of "aws_security_group" "nrpe")
                                                      (id-of "aws_security_group" (str "uses-db-" (vpc-unique "alerts")))
                                                      (vpc-id-of "aws_security_group" "allow-elb-alerts")
                                                      (vpc-id-of "aws_security_group" "all-servers")
                                                      (vpc-id-of "aws_security_group" "sends_influx")]})

              (elb "alerts" resource {:name "alerts"
                                      :health_check {:healthy_threshold 2
                                                     :unhealthy_threshold 3
                                                     :target "HTTP:80/"
                                                     :timeout 5
                                                     :interval 30}
                                      :listener [(elb-listener (if cert-name
                                                                  {:lb-port 443 :lb-protocol "https" :port 80 :protocol "http" :cert-name cert-name}
                                                                  {:port 80 :protocol "http"}))]
                                      :subnets (mapv #(id-of "aws_subnet" (stringify  vpc-name "-public-" %)) azs)
                                      :instances [(id-of "aws_instance" (vpc-unique "alerts"))]
                                      :security_groups (map #(id-of "aws_security_group" %)
                                                            ["allow_outbound"
                                                             "allow_external_http_https"
                                                             (vpc-unique "elb-alerts")
                                                             ])})

              (vpc-security-group "elb-alerts" {})
              (vpc-security-group "allow-elb-alerts" {}
                                  {:port 80
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-alerts")})

              (vpc-security-group "elb-kibana" {}
                                  {:port 80
                                   :cidr_blocks [vpc-cidr-block]}
                                  {:port 443
                                   :cidr_blocks [vpc-cidr-block]})
              (vpc-security-group "allow-elb-kibana" {}
                                  {:port 80
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-kibana")}
                                  {:port 443
                                   :source_security_group_id (vpc-id-of "aws_security_group" "elb-kibana")})
              (vpc-security-group  "kibana" {}
                                   {:type "egress"
                                    :from_port 0
                                    :to_port 0
                                    :protocol -1
                                    :cidr_blocks [all-external]})

              )))))

Change to use account wide access policy to ES


(ns ^{:author "Daniel Leong"
      :doc "Core interface"}
  rainboots.core
  (:require [aleph.tcp :as tcp]
            [manifold.stream :as s]
            [rainboots
             [color :refer [determine-colors process-colors
                            strip-colors]]
             [command :refer [default-on-cmd]]
             [proto :refer [tn-iac wrap-stream]]
             [util :refer [log wrap-fn]]]))

(def default-port 4321)

(def ^:dynamic *svr*)

(declare telnet!)

(defn- make-client
  [stream]
  {:stream stream
   :term-types #{}
   :input-stack (atom[])})

(defmacro with-binds
  [& body]
  `(binding [*svr* ~'svr]
     ~@body))

(def default-telnet-opts
  #{:term-type})

(defn- handle-telnet
  [cli pkt accepted-opts fallback]
  (cond
    ;; the client can send term type! request it
    (= {:telnet :will
        :opt :term-type} pkt)
    (telnet! cli {:telnet :term-type
                  :opt [:send]})
    ;; the client is sending their term type
    (= :term-type (:telnet pkt))
    (if-not (contains? (:term-types @cli) (:opt pkt))
      (do
        ;; another new term type; keep requesting until
        ;;  we know them all
        (swap! cli update :term-types conj (:opt pkt))
        (telnet! cli {:telnet :term-type :opt [:send]}))
      ;; we've got 'em all; preprocess for color
      (determine-colors cli))
    (= :will (:telnet pkt))
    (if (contains? accepted-opts (:opt pkt))
      (telnet! cli {:telnet :do :opt (:opt pkt)})
      (telnet! cli {:telnet :wont :opt (:opt pkt)}))
    ;; else, let the provided callback handle
    :else
    (fallback cli pkt)))

(defn- handler
  [svr opts s info]
  (log "* New Client: " info)
  (let [on-connect (:on-connect opts)
        on-auth (:on-auth opts)
        on-cmd (:on-cmd opts)
        on-404 (:on-404 opts)
        telnet-opts (:telnet-opts opts)
        on-telnet (:on-telnet opts)
        on-disconnect (:on-disconnect opts)
        client (atom {})
        wrapped
        (wrap-stream
          s
          (fn [s pkt]
            (with-binds
             (if (string? pkt)
               ;; string pkt...
               (if (:ch @client)
                 ;; logged in; use cmd handler
                 (on-cmd client pkt)
                 ;; need auth still
                 (on-auth client pkt))
               ;; simple; telnet pkt
               (handle-telnet client pkt
                              telnet-opts on-telnet)))))]
    (reset! client (make-client wrapped))
    (swap! (:connected @svr) conj client)
    (with-binds
      (on-connect client))
    (s/on-closed
      s
      (fn []
        (swap! (:connected @svr) disj client)
        (with-binds
          (on-disconnect client))))
    ;; request terminal type
    ;; FIXME we should allow specifying more than :do
    (doseq [opt accepted-opts]
      (telnet! client {:telnet :do
                       :opt opt}))))

;;
;; Server control
;;

(defn- -start-server
  "NB: You should use (start-server)
  instead of using this directly."
  [& {:keys [port
             on-auth on-cmd
             on-404
             on-connect on-disconnect
             on-telnet]
      :as opts}]
  {:pre [(not (nil? on-connect))
         (not (nil? on-cmd))
         (not (nil? on-auth))]}
  (let [obj (atom {:connected (atom #{})})
        svr (tcp/start-server
              (partial handler obj opts)
              opts)]
    (swap! obj assoc :closable svr)
    ;; re-def dynamically so there's some
    ;;  default value for use in REPL; handlers
    ;;  should always get the correct instance
    ;;  thanks to use of (binding) above (although
    ;;  I'm not sure why you'd start more than one
    ;;  server in the same JVM, anyway....)
    (def ^:dynamic *svr* obj)
    obj))

(defmacro start-server
  "Start up a server with the provided
  callbacks and options. This is a macro
  so that you can supply function references
  and still easily update them via repl.
  Options:
  :port Port on which to start the server
  :telnet-opts A set of handled telnet op codes.
               will automatically specify 'WILL'
               for these opts. May be keywords
               specified in rainboots.proto, or
               the raw int value. By default, we
               will handle :term-type and fill out
               a set in :term-types of the client map
  Callbacks:
  :on-auth (fn [cli line]) Called on each
           raw line of input from the client
           until they have something in the
           :ch field of the `cli` atom. This
           should be where you store the
           character info.
  :on-cmd (fn [cli cmd]) Called on each command
          input from an auth'd client."
  [& {:keys [port
             telnet-opts
             on-auth on-cmd
             on-404
             on-connect on-disconnect
             on-telnet]
      :or {port default-port
           telnet-opts default-telnet-opts
           on-404 `(fn [cli# & etc#]
                     (send! cli# "Huh?"))
           on-disconnect `(constantly nil)
           on-telnet `(constantly nil)}
      :as opts}]
  ;; NB: this lets us call the private function
  ;;  even from a macro:
  (let [on-cmd (if on-cmd
                 on-cmd
                 `(partial default-on-cmd ~on-404))]
    `(#'-start-server
       :port ~port
       :telnet-opts ~telnet-opts
       :on-auth (wrap-fn ~on-auth)
       :on-connect (wrap-fn ~on-connect)
       :on-cmd (wrap-fn ~on-cmd)
       :on-404 (wrap-fn ~on-404)
       :on-disconnect (wrap-fn ~on-disconnect)
       :on-telnet (wrap-fn ~on-telnet))))

(defn stop-server
  [server]
  (.close (:closable @server)))

;;
;; Communication
;;

(defn close!
  "Disconnect the client"
  [cli]
  (s/close! (:stream @cli)))

(defn send!
  "Send text to the client. You can pass in a variable
  number of args, which may in turn be strings, vectors,
  or functions. Vectors will be treated as additional
  varargs (IE: (apply)'d to this function).  Functions
  will be called with the client as a single argument,
  and the result sent as if it were passed directly.
  Strings, and any string returned by a function argument
  or in a vector, will be processed for color sequences
  (see the colors module).
  Maps will be treated as telnet sequences (see telnet!)"
  [cli & body]
  (when-let [s (:stream @cli)]
    (doseq [p body]
      (when p
        (condp #(%1 %2) p
          vector? (apply send! cli p)
          string? (s/put! s (if (:colors @cli)
                              (process-colors p)
                              (strip-colors p)))
          map? (s/put! s p)
          fn? (send! cli (p cli)))))
    (s/put! s "\r\n")))

(defn send-if!
  "Send text to every connected client for which
  (pred cli) returns true. The arguments will be
  handled in the same way (send!) handles them."
  [pred & body]
  (when-let [clients (seq @(:connected @*svr*))]
    (doseq [cli clients]
      (when (pred cli)
        (apply send! cli body)))))

(defn send-all!
  "Send text to every connected client. This is
  a convenience function."
  [& body]
  (apply send-if! (constantly true) body))

(defn telnet!
  "Send a telnet map (like thsoe received in :on-telnet)
  or a vector of raw bytes as a telnet instruction. Telnet
  maps can also be sent using (send!) for convenience;
  note, however, that send! appends an '\\r\\n' sequence
  to whatever is passed, so if you ONLY want to send a
  telnet sequence, this is the way to go."
  [cli telnet]
  (when-let [s (:stream @cli)]
    (cond
      ;; raw bytes vector
      (and (vector? telnet)
           (= tn-iac (first telnet)))
      (s/put! s (byte-array telnet))
      ;; improper telnet sequence
      (vector? telnet)
      (throw (IllegalArgumentException.
               (str "Telnet byte sequences must start"
                    "with tn-iac constant")))
      ;; it's a map; the protocol will handle it
      (map? telnet)
      (s/put! s telnet))
    (s/put! s "\r")))

(defn push-cmds!
  "Push a new cmdset to the top of the user's
  input stack. Only function at the top of this
  stack receives input. This is only meaningful
  if you haven't provided your own on-cmd handler
  (but why would you?).
  The provided cmd-set can be anything declared
  with (defcmdset), or, in fact, any function
  that looks like (fn [on-404 cli input]), where:
  `on-404 is the function configured for
  when a command doesn't exist;
  `cli` is the client providing the input; and
  `input` is the raw String input line"
  [cli cmd-set]
  (swap! (:input-stack @cli) conj cmd-set))

(defn pop-cmds!
  "Pop the top-most cmdset from the user's
  input stack. See push-cmds!"
  [cli]
  (swap! (:input-stack @cli) pop))

(ns ^{:author "Daniel Leong"
      :doc "Core interface"}
  rainboots.core
  (:require [aleph.tcp :as tcp]
            [manifold.stream :as s]
            [rainboots
             [color :refer [determine-colors process-colors
                            strip-colors]]
             [command :refer [default-on-cmd]]
             [proto :refer [tn-iac wrap-stream]]
             [util :refer [log wrap-fn]]]))

(def default-port 4321)

(def ^:dynamic *svr*)

(declare telnet!)

(defn- make-client
  [stream]
  {:stream stream
   :term-types #{}
   :input-stack (atom[])})

(defmacro with-binds
  [& body]
  `(binding [*svr* ~'svr]
     ~@body))

(def default-telnet-opts
  #{:term-type})

(defn- handle-telnet
  [cli pkt accepted-opts fallback]
  (cond
    ;; the client can send term type! request it
    (= {:telnet :will
        :opt :term-type} pkt)
    (telnet! cli {:telnet :term-type
                  :opt [:send]})
    ;; the client is sending their term type
    (= :term-type (:telnet pkt))
    (if-not (contains? (:term-types @cli) (:opt pkt))
      (do
        ;; another new term type; keep requesting until
        ;;  we know them all
        (swap! cli update :term-types conj (:opt pkt))
        (telnet! cli {:telnet :term-type :opt [:send]}))
      ;; we've got 'em all; preprocess for color
      (determine-colors cli))
    (= :will (:telnet pkt))
    (if (contains? accepted-opts (:opt pkt))
      (telnet! cli {:telnet :do :opt (:opt pkt)})
      (telnet! cli {:telnet :wont :opt (:opt pkt)}))
    ;; else, let the provided callback handle
    :else
    (fallback cli pkt)))

(defn- handler
  [svr opts s info]
  (log "* New Client: " info)
  (let [on-connect (:on-connect opts)
        on-auth (:on-auth opts)
        on-cmd (:on-cmd opts)
        on-404 (:on-404 opts)
        telnet-opts (:telnet-opts opts)
        on-telnet (:on-telnet opts)
        on-disconnect (:on-disconnect opts)
        client (atom {})
        wrapped
        (wrap-stream
          s
          (fn [s pkt]
            (with-binds
             (if (string? pkt)
               ;; string pkt...
               (if (:ch @client)
                 ;; logged in; use cmd handler
                 (on-cmd client pkt)
                 ;; need auth still
                 (on-auth client pkt))
               ;; simple; telnet pkt
               (handle-telnet client pkt
                              telnet-opts on-telnet)))))]
    (reset! client (make-client wrapped))
    (swap! (:connected @svr) conj client)
    (with-binds
      (on-connect client))
    (s/on-closed
      s
      (fn []
        (swap! (:connected @svr) disj client)
        (with-binds
          (on-disconnect client))))
    ;; request terminal type
    ;; FIXME we should allow specifying more than :do
    (doseq [opt telnet-opts]
      (telnet! client {:telnet :do
                       :opt opt}))))

;;
;; Server control
;;

(defn- -start-server
  "NB: You should use (start-server)
  instead of using this directly."
  [& {:keys [port
             on-auth on-cmd
             on-404
             on-connect on-disconnect
             on-telnet]
      :as opts}]
  {:pre [(not (nil? on-connect))
         (not (nil? on-cmd))
         (not (nil? on-auth))]}
  (let [obj (atom {:connected (atom #{})})
        svr (tcp/start-server
              (partial handler obj opts)
              opts)]
    (swap! obj assoc :closable svr)
    ;; re-def dynamically so there's some
    ;;  default value for use in REPL; handlers
    ;;  should always get the correct instance
    ;;  thanks to use of (binding) above (although
    ;;  I'm not sure why you'd start more than one
    ;;  server in the same JVM, anyway....)
    (def ^:dynamic *svr* obj)
    obj))

(defmacro start-server
  "Start up a server with the provided
  callbacks and options. This is a macro
  so that you can supply function references
  and still easily update them via repl.
  Options:
  :port Port on which to start the server
  :telnet-opts A set of handled telnet op codes.
               will automatically specify 'WILL'
               for these opts. May be keywords
               specified in rainboots.proto, or
               the raw int value. By default, we
               will handle :term-type and fill out
               a set in :term-types of the client map
  Callbacks:
  :on-auth (fn [cli line]) Called on each
           raw line of input from the client
           until they have something in the
           :ch field of the `cli` atom. This
           should be where you store the
           character info.
  :on-cmd (fn [cli cmd]) Called on each command
          input from an auth'd client."
  [& {:keys [port
             telnet-opts
             on-auth on-cmd
             on-404
             on-connect on-disconnect
             on-telnet]
      :or {port default-port
           telnet-opts default-telnet-opts
           on-404 `(fn [cli# & etc#]
                     (send! cli# "Huh?"))
           on-disconnect `(constantly nil)
           on-telnet `(constantly nil)}
      :as opts}]
  ;; NB: this lets us call the private function
  ;;  even from a macro:
  (let [on-cmd (if on-cmd
                 on-cmd
                 `(partial default-on-cmd ~on-404))]
    `(#'-start-server
       :port ~port
       :telnet-opts ~telnet-opts
       :on-auth (wrap-fn ~on-auth)
       :on-connect (wrap-fn ~on-connect)
       :on-cmd (wrap-fn ~on-cmd)
       :on-404 (wrap-fn ~on-404)
       :on-disconnect (wrap-fn ~on-disconnect)
       :on-telnet (wrap-fn ~on-telnet))))

(defn stop-server
  [server]
  (.close (:closable @server)))

;;
;; Communication
;;

(defn close!
  "Disconnect the client"
  [cli]
  (s/close! (:stream @cli)))

(defn send!
  "Send text to the client. You can pass in a variable
  number of args, which may in turn be strings, vectors,
  or functions. Vectors will be treated as additional
  varargs (IE: (apply)'d to this function).  Functions
  will be called with the client as a single argument,
  and the result sent as if it were passed directly.
  Strings, and any string returned by a function argument
  or in a vector, will be processed for color sequences
  (see the colors module).
  Maps will be treated as telnet sequences (see telnet!)"
  [cli & body]
  (when-let [s (:stream @cli)]
    (doseq [p body]
      (when p
        (condp #(%1 %2) p
          vector? (apply send! cli p)
          string? (s/put! s (if (:colors @cli)
                              (process-colors p)
                              (strip-colors p)))
          map? (s/put! s p)
          fn? (send! cli (p cli)))))
    (s/put! s "\r\n")))

(defn send-if!
  "Send text to every connected client for which
  (pred cli) returns true. The arguments will be
  handled in the same way (send!) handles them."
  [pred & body]
  (when-let [clients (seq @(:connected @*svr*))]
    (doseq [cli clients]
      (when (pred cli)
        (apply send! cli body)))))

(defn send-all!
  "Send text to every connected client. This is
  a convenience function."
  [& body]
  (apply send-if! (constantly true) body))

(defn telnet!
  "Send a telnet map (like thsoe received in :on-telnet)
  or a vector of raw bytes as a telnet instruction. Telnet
  maps can also be sent using (send!) for convenience;
  note, however, that send! appends an '\\r\\n' sequence
  to whatever is passed, so if you ONLY want to send a
  telnet sequence, this is the way to go."
  [cli telnet]
  (when-let [s (:stream @cli)]
    (cond
      ;; raw bytes vector
      (and (vector? telnet)
           (= tn-iac (first telnet)))
      (s/put! s (byte-array telnet))
      ;; improper telnet sequence
      (vector? telnet)
      (throw (IllegalArgumentException.
               (str "Telnet byte sequences must start"
                    "with tn-iac constant")))
      ;; it's a map; the protocol will handle it
      (map? telnet)
      (s/put! s telnet))
    (s/put! s "\r")))

(defn push-cmds!
  "Push a new cmdset to the top of the user's
  input stack. Only function at the top of this
  stack receives input. This is only meaningful
  if you haven't provided your own on-cmd handler
  (but why would you?).
  The provided cmd-set can be anything declared
  with (defcmdset), or, in fact, any function
  that looks like (fn [on-404 cli input]), where:
  `on-404 is the function configured for
  when a command doesn't exist;
  `cli` is the client providing the input; and
  `input` is the raw String input line"
  [cli cmd-set]
  (swap! (:input-stack @cli) conj cmd-set))

(defn pop-cmds!
  "Pop the top-most cmdset from the user's
  input stack. See push-cmds!"
  [cli]
  (swap! (:input-stack @cli) pop))

Fix compile issue

Fix compile issue


(ns chili-dog-night.views
  (:require [hiccup.page :as h]
            [hiccup.element :as el]
            [clj-rss.core :as rss]
            [clj-time.core :as t]
            [clj-time.coerce :as c]
            [clj-time.format :as f]
            [clojure.string :as str]))

(defn header []
  [:header {:role "banner"}
   [:h1 (el/link-to "/" "Chili Dog Night")]
   [:nav
    (el/unordered-list [(el/link-to "/about" "About")
                        (el/link-to "/colophon" "Colophon")])]])

(defn footer []
  [:footer {:role "contentinfo"}
   [:p "© 2016 Chili Dog Night Productions"]])

(defn common [title head body]
  (h/html5
   [:head
    [:meta {:charset "utf-8"}]
    [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge,chrome=1"}]
    [:meta {:name "viewport" :content "width=device-width, initial-scale=1, maximum-scale=1"}]
    (h/include-css "//fonts.googleapis.com/css?family=Playfair+Display:400,400italic,700,700italic,900,900italic")
    (h/include-css "/css/styles.css")
    [:title (str title " | " "Chili Dog Night")]
    [:link {:rel "alternate" :type "application/rss+xml" :href "/rss" :title "Chili Dog Night"}]
    head]
   [:body
    (header)
    [:main body]
    (footer)]))

(defn film-citation [film]
  [:cite {:itemscope ""
          :itemtype "http://schema.org/Movie"}
   [:meta {:itemprop "name"
           :content (:title film)}]
   (el/link-to (:uri film)
               (str/replace (:title film) #"\s" " "))])

(defn person [name]
  [:span {:itemscope ""
          :itemtype "http://schema.org/Person"}
   [:span {:itemprop "name"} name]])

(defn comma-separate-str [coll]
  (if (= (count coll) 1)
    (first coll)
    (str (reduce #(str % ", " %2) (drop-last coll))
       ", and "
       (last coll))))

(defn comma-separate [coll]
  (reduce into (concat
                (map #(vec [% ", "])
                     (drop-last 2 coll))
                (reduce #(vec [[ % ", and "] [%2]])
                        (take-last 2 coll)))))

(defn gathering-partial [data]
  [:section
   [:h2 (:date data)]
   (reduce into [:p]
           [(comma-separate (map person (sort (:attendees data))))
            " experienced "
            (comma-separate (map film-citation (:media data)))
            ". They ate "
            (comma-separate-str (:food data))
            "."])
   [:p "This is what they discussed during, and between films:"]
   (:notes data)])

(defn not-found []
  (common "404"
          [:meta {:description "You look lost."}]
          [:section
           [:h2 404]
           [:p "The resource you requested was not found."]]))

(defn home [data]
  (common "Our cinematic torture chamber."
          [:meta {:description "This is the story of a friendship forged in food, film, and fear. It is pain, but it is also laughter. This is Chili Dog Night."}]
          (gathering-partial data)))

(defn gathering [data]
  (common (:date data)
          [:meta {:description (:synopsis data)}]
          (gathering-partial data)))

(defn about []
  (common "About"
          [:meta {:description "Somehow we got the part. Don't ask. This is Chili Dog Night."}]
          [:section
           [:h2 "About"]
           [:p "Chili Dog Night is a celebration of the worst kinds of moving images "
            "experienced in tandem with relatively unhealthy foods. "
            "The primary objective is to deconstruct and ridicule movies that don't have an "
            "excuse for their bad behavior. While the occasional obvious choice is "
            "consumed, like "
            (film-citation {:title "The Room" :uri "http://www.theroommovie.com/"})
            ", the real focus, and most painful kind of movie, is mainstream mediocrity, like "
            (film-citation {:title "Aloha" :uri "http://www.imdb.com/title/tt1243974/"})
            "."]
           [:p "As of this moment Chili Dog Night is "
            (person "Alex Sanchez")
            ", "
            (person "Jason Aumann")
            ", "
            (person "Greg Ryan")
            ", "
            (person "Jacob Dobner")
            ", "
            (person "Matt Beck")
            ", "
            (person "Colin Teal")
            ", and Kaia. They all hail from Seattle, and are slowly losing their minds one film at a time."]]))

(defn colophon []
  (common "Colophon"
          [:meta {:description "We made it good with a beginning, middle, and end. This is Chili Dog Night."}]
          [:section
           [:h2 "Colophon"]
           [:p "This website was made possible by "
            (el/link-to "http://clojure.org/" "Clojure")
            " and "
            (el/link-to "https://github.com/clojure/clojurescript" "ClojureScript")
            ". Compilation of the application is facilitated by "
            (el/link-to "http://boot-clj.com/" "Boot")
            " and its myriad friends (e.g., "
            (el/link-to "https://github.com/adzerk-oss/boot-cljs" "boot-cljs")
            ", "
            (el/link-to "https://github.com/adzerk-oss/boot-reload" "boot-reload")
            ", and "
            (el/link-to "https://github.com/pandeiro/boot-http" "boot-http")
            "). Hypertext Markup Language (HTML) is generated via "
            (el/link-to "https://github.com/weavejester/hiccup" "Hiccup")
            ", and the Cascading Style Sheets (CSS) are grown with help from "
            (el/link-to "https://github.com/noprompt/garden" "Garden")
            ". The Really Simple Syndication (RSS) feed is created via "
            (el/link-to "https://github.com/yogthos/clj-rss" "clj-rss")
            ". The font used throughout is "
            (el/link-to "https://www.google.com/fonts/specimen/Playfair+Display" "Playfair Display")
            " provided by "
            (el/link-to "https://www.google.com/fonts" "Google Fonts")
            "."]
           [:p "The domain name was purchased through "
            (el/link-to "https://www.namecheap.com/" "NameCheap")
            ". Hosting of the application is provided by "
            (el/link-to "https://www.heroku.com" "Heroku")
            ". The project source code is publicly available and stored on "
            (el/link-to "https://github.com/chili-dog-night/site" "GitHub")
            "."]]))

(defn str->date [str]
  (c/to-date (f/parse (f/formatter "yyyy/MM/dd") str)))

(defn rss-feed-item [item]
  (let [date (:date item)]
    {:title date
     :pubDate (str->date date)
     :description (:synopsis item)
     :link (str "http://www.chilidognight.com/gatherings/" date)}))

(defn rss-feed [items]
  (rss/channel-xml {:title "Chili Dog Night"
                    :language "en-us"
                    :pubDate (c/to-date (t/today-at 12 00))
                    :lastBuildDate (str->date (:date (first items)))
                    :docs "http://blogs.law.harvard.edu/tech/rss"
                    :link "http://www.chilidognight.com"
                    :copyright "Copyright 2016, Chili Dog Night Productions"
                    :description "The latest gatherings from your friends at Chili Dog Night."}
                   (map rss-feed-item items)))

(ns chili-dog-night.views
  (:require [hiccup.page :as h]
            [hiccup.element :as el]
            [clj-rss.core :as rss]
            [clj-time.core :as t]
            [clj-time.coerce :as c]
            [clj-time.format :as f]
            [clojure.string :as str]))

(defn header []
  [:header {:role "banner"}
   [:h1 (el/link-to "/" "Chili Dog Night")]
   [:nav
    (el/unordered-list [(el/link-to "/about" "About")
                        (el/link-to "/colophon" "Colophon")])]])

(defn footer []
  [:footer {:role "contentinfo"}
   [:p "© 2016 Chili Dog Night Productions"]])

(defn common [title head body]
  (h/html5
   [:head
    [:meta {:charset "utf-8"}]
    [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge,chrome=1"}]
    [:meta {:name "viewport" :content "width=device-width, initial-scale=1, maximum-scale=1"}]
    (h/include-css "//fonts.googleapis.com/css?family=Playfair+Display:400,400italic,700,700italic,900,900italic")
    (h/include-css "/css/styles.css")
    [:title (str title " | " "Chili Dog Night")]
    [:link {:rel "alternate" :type "application/rss+xml" :href "/rss" :title "Chili Dog Night"}]
    head]
   [:body
    (header)
    [:main body]
    (footer)]))

(defn film-citation [film]
  [:cite {:itemscope ""
          :itemtype "http://schema.org/Movie"}
   [:meta {:itemprop "name"
           :content (:title film)}]
   (el/link-to (:uri film)
               (str/replace (:title film) #"\s" " "))])

(defn person [name]
  [:span {:itemscope ""
          :itemtype "http://schema.org/Person"}
   [:span {:itemprop "name"} name]])

(defn comma-separate-str [coll]
  (if (= (count coll) 1)
    (first coll)
    (str (reduce #(str % ", " %2) (drop-last coll))
       ", and "
       (last coll))))

(defn comma-separate [coll]
  (reduce into (concat
                (map #(vec [% ", "])
                     (drop-last 2 coll))
                (reduce #(vec [[ % ", and "] [%2]])
                        (take-last 2 coll)))))

(defn gathering-partial [data]
  [:section
   [:h2 (:date data)]
   (reduce into [:p]
           [(comma-separate (map person (sort (:attendees data))))
            " experienced "
            (comma-separate (map film-citation (:media data)))
            ". They ate "
            (comma-separate-str (:food data))
            "."])
   [:p "This is what they discussed during, and between films:"]
   (:notes data)])

(defn not-found []
  (common "404"
          [:meta {:name "description" :content "You look lost."}]
          [:section
           [:h2 404]
           [:p "The resource you requested was not found."]]))

(defn home [data]
  (common "Our cinematic torture chamber."
          [:meta {:name "description" :content "This is the story of a friendship forged in food, film, and fear. It is pain, but it is also laughter. This is Chili Dog Night."}]
          (gathering-partial data)))

(defn gathering [data]
  (common (:date data)
          [:meta {:name "description" :content (:synopsis data)}]
          (gathering-partial data)))

(defn about []
  (common "About"
          [:meta {:name "description" :content "Somehow we got the part. Don't ask. This is Chili Dog Night."}]
          [:section
           [:h2 "About"]
           [:p "Chili Dog Night is a celebration of the worst kinds of moving images "
            "experienced in tandem with relatively unhealthy foods. "
            "The primary objective is to deconstruct and ridicule movies that don't have an "
            "excuse for their bad behavior. While the occasional obvious choice is "
            "consumed, like "
            (film-citation {:title "The Room" :uri "http://www.theroommovie.com/"})
            ", the real focus, and most painful kind of movie, is mainstream mediocrity, like "
            (film-citation {:title "Aloha" :uri "http://www.imdb.com/title/tt1243974/"})
            "."]
           [:p "As of this moment Chili Dog Night is "
            (person "Alex Sanchez")
            ", "
            (person "Jason Aumann")
            ", "
            (person "Greg Ryan")
            ", "
            (person "Jacob Dobner")
            ", "
            (person "Matt Beck")
            ", "
            (person "Colin Teal")
            ", and Kaia. They all hail from Seattle, and are slowly losing their minds one film at a time."]]))

(defn colophon []
  (common "Colophon"
          [:meta {:name "description" :content "We made it good with a beginning, middle, and end. This is Chili Dog Night."}]
          [:section
           [:h2 "Colophon"]
           [:p "This website was made possible by "
            (el/link-to "http://clojure.org/" "Clojure")
            " and "
            (el/link-to "https://github.com/clojure/clojurescript" "ClojureScript")
            ". Compilation of the application is facilitated by "
            (el/link-to "http://boot-clj.com/" "Boot")
            " and its myriad friends (e.g., "
            (el/link-to "https://github.com/adzerk-oss/boot-cljs" "boot-cljs")
            ", "
            (el/link-to "https://github.com/adzerk-oss/boot-reload" "boot-reload")
            ", and "
            (el/link-to "https://github.com/pandeiro/boot-http" "boot-http")
            "). Hypertext Markup Language (HTML) is generated via "
            (el/link-to "https://github.com/weavejester/hiccup" "Hiccup")
            ", and the Cascading Style Sheets (CSS) are grown with help from "
            (el/link-to "https://github.com/noprompt/garden" "Garden")
            ". The Really Simple Syndication (RSS) feed is created via "
            (el/link-to "https://github.com/yogthos/clj-rss" "clj-rss")
            ". The font used throughout is "
            (el/link-to "https://www.google.com/fonts/specimen/Playfair+Display" "Playfair Display")
            " provided by "
            (el/link-to "https://www.google.com/fonts" "Google Fonts")
            "."]
           [:p "The domain name was purchased through "
            (el/link-to "https://www.namecheap.com/" "NameCheap")
            ". Hosting of the application is provided by "
            (el/link-to "https://www.heroku.com" "Heroku")
            ". The project source code is publicly available and stored on "
            (el/link-to "https://github.com/chili-dog-night/site" "GitHub")
            "."]]))

(defn str->date [str]
  (c/to-date (f/parse (f/formatter "yyyy/MM/dd") str)))

(defn rss-feed-item [item]
  (let [date (:date item)]
    {:title date
     :pubDate (str->date date)
     :description (:synopsis item)
     :link (str "http://www.chilidognight.com/gatherings/" date)}))

(defn rss-feed [items]
  (rss/channel-xml {:title "Chili Dog Night"
                    :language "en-us"
                    :pubDate (c/to-date (t/today-at 12 00))
                    :lastBuildDate (str->date (:date (first items)))
                    :docs "http://blogs.law.harvard.edu/tech/rss"
                    :link "http://www.chilidognight.com"
                    :copyright "Copyright 2016, Chili Dog Night Productions"
                    :description "The latest gatherings from your friends at Chili Dog Night."}
                   (map rss-feed-item items)))

Fix meta descriptions

Fix meta descriptions


(ns frereth-cp.client
  "Implement the client half of the CurveCP protocol.

  It seems like it would be nice if I could just declare
  the message exchange, but that approach gets complicated
  on the server side. At least half the point there is
  reducing DoS.

  This really doesn't seem to belong in here. I keep going
  back and forth about that. It seems like it would be
  cleaner to move this into the frereth.client, and the
  server component into frereth.server.

  But that makes it much more difficult to test."
  (:require [byte-streams :as b-s]
            #_[clojure.core.async :as async]
            [clojure.pprint :refer (pprint)]
            [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [frereth-cp.client.cookie :as cookie]
            [frereth-cp.client.state :as state]
            [frereth-cp.schema :as schema]
            [frereth-cp.shared :as shared]
            [frereth-cp.shared.bit-twiddling :as b-t]
            [frereth-cp.shared.crypto :as crypto]
            [frereth-cp.shared.constants :as K]
            [frereth-cp.util :as util]
            #_[com.stuartsierra.component :as cpt]
            [manifold.deferred :as deferred]
            [manifold.stream :as strm])
  (:import clojure.lang.ExceptionInfo
           [io.netty.buffer ByteBuf Unpooled]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Magic Constants

(def heartbeat-interval (* 15 shared/millis-in-second))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Specs

;; Q: More sensible to check for strm/source and sink protocols?

(s/def ::reader (s/keys :req [::state/chan<-child]))
(s/def ::writer (s/keys :req [::state/chan->child]))
;; This stream is for sending ByteBufs back to the child when we're done
;; Tracking them in a thread-safe pool seems like a better approach.
;; Especially when we're talking about the server.
;; But I have to get a first draft written before I can worry about details
;; like that.
;; Actually, I pretty much have to have access to that pool now, so messages
;; can go the other way.
;; I could try to get clever and try to reuse buffers when we have a basic
;; request/response scenario. But that idea totally falls apart if the
;; communication is mostly one-sided.
;; It's available as a potential optimization, but it probably only
;; makes sense from the "child" perspective, where we have more knowledge
;; about the expected traffic patterns.
;; TODO: Switch to PooledByteBufAllocator
;; Instead of mucking around with this release-notifier nonsense
(s/def ::release ::writer)
;; Accepts the agent that owns "this" and returns
;; 1) a writer channel we can use to send messages to the child.
;; 2) a reader channel that the child will use to send byte
;; arrays/bufs to us
(s/def ::child-spawner (s/fspec :args (s/cat :this ::state-agent)
                                :ret (s/keys :req [::child
                                                   ::reader
                                                   ::release
                                                   ::writer])))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal

(defn hide-long-arrays
  "Make pretty printing a little less verbose"
  [this]
  ;; In some scenarios, we're winding up with the client as a
  ;; deferred.
  ;; This is specifically happening when my interaction test
  ;; throws an unhandled exception.
  ;; I probably shouldn't do this to try to work around that problem,
  ;; but I really want/need as much debug info as I can get in
  ;; that sort of scenario
  (let [this (if (associative? this)
               this
               (try
                 (assoc @this ::-hide-long-array-notice "This was a deferred")
                 (catch java.lang.ClassCastException ex
                   (throw (ex-info (str @this ": deferred that breaks everything")
                                   {:cause (str ex)})))))]
    (-> this
        ;; TODO: Write a mirror image version of dns-encode to just show this
        (assoc-in [::server-security ::shared/server-name] "name")
        (assoc-in [::shared/packet-management ::shared/packet] "...packet bytes...")
        (assoc-in [::shared/work-area ::shared/working-nonce] "...FIXME: Decode nonce bytes")
        (assoc-in [::shared/work-area ::shared/text] "...plain/cipher text"))))

(defn extract-child-message
  "Pretty much blindly translated from the CurveCP reference
implementation. This is code that I don't understand yet"
  [this buffer]
  (let [reducer (fn [{:keys [buf
                             buf-len
                             msg
                             msg-len
                             i
                             this]
                      :as acc}
                     b]
                  (when (or (< msg-len 0)
                            ;; This is the flag that the stream has exited.
                            ;; Q: Is that what it's being used for here?
                            (> msg-len 2048))
                    (throw (ex-info "done" {})))
                  ;; It seems silly to set this and then check the first byte
                  ;; for the quit signal (assuming that's what it is)
                  ;; every time through the loop.
                  (aset msg msg-len (aget buf i))
                  (let [msg-len (inc msg-len)
                        length-code (aget msg 0)]
                    (when (bit-and length-code 0x80)
                      (throw (ex-info "done" {})))
                    (if (= msg-len (inc (* 16 length-code)))
                      (let [{:keys [extension
                                    my-keys
                                    packet-management
                                    server-extension
                                    shared-secrets
                                    server-security
                                    text
                                    vouch
                                    work-area]
                             :as this} (clientextension-init this)
                            {:keys [::shared/packet
                                    ::shared/packet-nonce]} packet-management
                            _ (throw (RuntimeException. "this Component nonce isn't updated"))
                            short-term-nonce (update-client-short-term-nonce
                                              packet-nonce)
                            working-nonce (::shared/working-nonce work-area)]
                        (b-t/uint64-pack! working-nonce K/client-nonce-prefix-length
                                             short-term-nonce)
                        ;; This is where the original splits, depending on whether
                        ;; we've received a message back from the server or not.
                        ;; According to the spec:
                        ;; The server is free to send any number of Message packets
                        ;; after it sees the Initiate packet.
                        ;; The client is free to send any number of Message packets
                        ;; after it sees the server's first Message packet.
                        ;; At this point in time, we know we're still building the
                        ;; Initiate packet.
                        ;; It's tempting to try to avoid duplication the same
                        ;; way the reference implementation does, by handling
                        ;; both logical branches here.
                        ;; And maybe there's a really good reason for doing so.
                        ;; But this function feels far too complex as it is.
                        (let [r (dec msg-len)]
                          (when (or (< r 16)
                                    (> r 640))
                            (throw (ex-info "done" {})))
                          (b-t/byte-copy! working-nonce 0 K/client-nonce-prefix-length
                                          K/initiate-nonce-prefix)
                          ;; Reference version starts by zeroing first 32 bytes.
                          ;; I thought we just needed 16 for the encryption buffer
                          ;; And that doesn't really seem to apply here
                          ;; Q: What's up with this?
                          ;; (it doesn't seem to match the spec, either)
                          (b-t/byte-copy! text 0 32 shared/all-zeros)
                          (b-t/byte-copy! text 32 K/key-length
                                          (.getPublicKey (::shared/long-pair my-keys)))
                          (b-t/byte-copy! text 64 64 vouch)
                          (b-t/byte-copy! text
                                          128
                                          K/server-name-length
                                          (::K/server-name server-security))
                          ;; First byte is a magical length marker
                          ;; TODO: Double-check the original.
                          ;; This doesn't look right at all.
                          ;; I think I need a 32-byte offset for the decryption
                          ;; padding.
                          ;; And the call to open-after really seems like it should start
                          ;; at offset 384 instead of 0
                          (b-t/byte-copy! text 384 r msg 1)
                          (let [box (crypto/open-after (::state/client-short<->server-short shared-secrets)
                                                       text
                                                       0
                                                       (+ r 384)
                                                       working-nonce)
                                offset K/server-nonce-prefix-length]
                            ;; TODO: Switch to compose for this
                            (b-t/byte-copy! packet
                                            0
                                            offset
                                            K/initiate-header)
                            (b-t/byte-copy! packet offset
                                            K/extension-length server-extension)
                            (let [offset (+ offset K/extension-length)]
                              (b-t/byte-copy! packet offset
                                              K/extension-length extension)
                              (let [offset (+ offset K/extension-length)]
                                (b-t/byte-copy! packet offset K/key-length
                                                (.getPublicKey (::shared/short-pair my-keys)))
                                (let [offset (+ offset K/key-length)]
                                  (b-t/byte-copy! packet
                                                  offset
                                                  K/server-cookie-length
                                                  (::state/server-cookie server-security))
                                  (let [offset (+ offset K/server-cookie-length)]
                                    (b-t/byte-copy! packet offset
                                                    K/server-nonce-prefix-length
                                                    working-nonce
                                                    K/server-nonce-suffix-length)))))
                            ;; Original version sends off the packet, updates
                            ;; msg-len to 0, and goes back to pulling data from child/server.
                            (throw (ex-info "How should this really work?"
                                            {:problem "Need to break out of loop here"})))))
                      (assoc acc :msg-len msg-len))))
        extracted (reduce reducer
                          {:buf (byte-array 4096)
                           :buf-len 0
                           :msg (byte-array 2048)
                           :msg-len 0
                           :i 0
                           :this this}
                          buffer)]
    (assoc this ::state/outgoing-message (:child-msg extracted))))

(defn child-exited!
  [this]
  (throw (ex-info "child exited" this)))

(defn hello-failed!
  [this failure]
  (send this #(throw (ex-info "Hello failed"
                              (assoc %
                                     :problem failure)))))

(defn server-closed!
  "This seems pretty meaningless in a UDP context"
  [this]
  (throw (ex-info "Server Closed" this)))

(defn child->server
  "Child sent us (as an agent) a signal to add bytes to the stream to the server"
  [this msg]
  (throw (RuntimeException. "Not translated")))

(defn server->child
  "Received bytes from the server that need to be streamed back to child"
  [this msg]
  (throw (RuntimeException. "Not translated")))

(defn cope-with-successful-hello-creation
  [wrapper chan->server timeout]
  (let [raw-packet (get-in @wrapper
                           [::shared/packet-management
                            ::shared/packet])]
    (log/debug "client/start! Putting" raw-packet "onto" chan->server)
    ;; There's still an important break
    ;; with the reference implementation
    ;; here: this should be sending the
    ;; HELLO packet to multiple server
    ;; end-points to deal with them
    ;; going down.
    ;; I think it's supposed to happen
    ;; in a delayed interval, to give
    ;; each a short time to answer before
    ;; the next, but a major selling point
    ;; is not waiting for TCP buffers
    ;; to expire.
    (let [d (strm/try-put! chan->server
                           raw-packet
                           timeout
                           ::sending-hello-timed-out)]
      (deferred/on-realized d
        (partial cookie/wait-for-cookie wrapper)
        (partial hello-failed! wrapper)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public

(s/fdef start!
        :args (s/cat :this ::state/state-agent)
        ;; Q: Does this return anything meaningful at all?
        ;; A: Well, to remain consistent with the Component workflow,
        ;; it really should return the "started" agent.
        ;; Even though it really is just called for side-effects.
        :ret any?)
(defn start!
  "This almost seems like it belongs in ctor.

But not quite, since it's really the first in a chain of side-effects.

Q: Is there something equivalent I can set up using core.async?

Actually, this seems to be screaming to be rewritten on top of manifold
Deferreds.

For that matter, it seems like setting up a watch on an atom that's
specifically for something like this might make a lot more sense.

That way I wouldn't be trying to multi-purpose communications channels.

OTOH, they *are* the trigger for this sort of thing.

The reference implementation mingles networking with this code.
That seems like it might make sense as an optimization,
but not until I have convincing numbers that it's needed.
Of course, I might also be opening things up for something
like a timing attack."
  [wrapper]
  (when-let [failure (agent-error wrapper)]
    (throw (ex-info "Agent failed before we started"
                    {:problem failure})))

  (let [{:keys [::state/chan->server]} @wrapper
        timeout (state/current-timeout wrapper)]
    (strm/on-drained chan->server
                     (fn []
                       (log/warn "Channel->server closed")
                       (send wrapper server-closed!)))
    ;; This feels inside-out and backwards.
    ;; But it probably should, since this is very
    ;; explicitly place-oriented programming working
    ;; with mutable state.
    (send wrapper do-build-hello)
    (if (await-for timeout wrapper)
      (cope-with-successful-hello-creation wrapper chan->server timeout)
      (throw (ex-info (str "Timed out after " timeout
                           " milliseconds waiting to build HELLO packet")
                      {:problem (agent-error wrapper)})))))

(defn stop!
  [wrapper]
  (if-let [err (agent-error wrapper)]
    (log/error (str err "\nTODO: Is there any way to recover well enough to release the Packet Manager?\n"
                    (util/show-stack-trace err)))
    (send wrapper
          (fn [this]
            (shared/release-packet-manager! (::shared/packet-management this))))))

(s/fdef ctor
        :args (s/keys :req [::state/chan<-server
                            ::state/chan->server
                            ::shared/my-keys
                            ::state/server-security])
        :ret ::state/state-agent)
(defn ctor
  [opts]
  (-> opts
      state/initialize-immutable-values
      state/initialize-mutable-state!
      (assoc
       ;; This seems very cheese-ball, but they
       ;; *do* need to be part of the agent.
       ;; We definitely don't want multiple threads
       ;; messing with them
       ::shared/packet-management (shared/default-packet-manager)
       ::shared/work-area (shared/default-work-area))
      ;; Using a core.async go-loop is almost guaranteed
      ;; to be faster.
      ;; TODO: Verify the "almost" with numbers.
      ;; The more I try to switching, the more dubious this
      ;; approach seems.
      ;; pipelines might not make a lot of sense on the client,
      ;; since they're at least theoretically about increasing
      ;; throughput at the expense of latency.
      ;; But they probably make a lot of sense on some servers.
      agent))

(ns frereth-cp.client
  "Implement the client half of the CurveCP protocol.

  It seems like it would be nice if I could just declare
  the message exchange, but that approach gets complicated
  on the server side. At least half the point there is
  reducing DoS.

  This really doesn't seem to belong in here. I keep going
  back and forth about that. It seems like it would be
  cleaner to move this into the frereth.client, and the
  server component into frereth.server.

  But that makes it much more difficult to test."
  (:require [byte-streams :as b-s]
            #_[clojure.core.async :as async]
            [clojure.pprint :refer (pprint)]
            [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [frereth-cp.client.cookie :as cookie]
            [frereth-cp.client.hello :as hello]
            [frereth-cp.client.state :as state]
            [frereth-cp.schema :as schema]
            [frereth-cp.shared :as shared]
            [frereth-cp.shared.bit-twiddling :as b-t]
            [frereth-cp.shared.crypto :as crypto]
            [frereth-cp.shared.constants :as K]
            [frereth-cp.util :as util]
            [manifold.deferred :as deferred]
            [manifold.stream :as strm])
  (:import clojure.lang.ExceptionInfo
           [io.netty.buffer ByteBuf Unpooled]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Magic Constants

(def heartbeat-interval (* 15 shared/millis-in-second))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Specs

;; Q: More sensible to check for strm/source and sink protocols?

(s/def ::reader (s/keys :req [::state/chan<-child]))
(s/def ::writer (s/keys :req [::state/chan->child]))
;; This stream is for sending ByteBufs back to the child when we're done
;; Tracking them in a thread-safe pool seems like a better approach.
;; Especially when we're talking about the server.
;; But I have to get a first draft written before I can worry about details
;; like that.
;; Actually, I pretty much have to have access to that pool now, so messages
;; can go the other way.
;; I could try to get clever and try to reuse buffers when we have a basic
;; request/response scenario. But that idea totally falls apart if the
;; communication is mostly one-sided.
;; It's available as a potential optimization, but it probably only
;; makes sense from the "child" perspective, where we have more knowledge
;; about the expected traffic patterns.
;; TODO: Switch to PooledByteBufAllocator
;; Instead of mucking around with this release-notifier nonsense
(s/def ::release ::writer)
;; Accepts the agent that owns "this" and returns
;; 1) a writer channel we can use to send messages to the child.
;; 2) a reader channel that the child will use to send byte
;; arrays/bufs to us
(s/def ::child-spawner (s/fspec :args (s/cat :this ::state-agent)
                                :ret (s/keys :req [::child
                                                   ::reader
                                                   ::release
                                                   ::writer])))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal

(defn hide-long-arrays
  "Make pretty printing a little less verbose"
  [this]
  ;; In some scenarios, we're winding up with the client as a
  ;; deferred.
  ;; This is specifically happening when my interaction test
  ;; throws an unhandled exception.
  ;; I probably shouldn't do this to try to work around that problem,
  ;; but I really want/need as much debug info as I can get in
  ;; that sort of scenario
  (let [this (if (associative? this)
               this
               (try
                 (assoc @this ::-hide-long-array-notice "This was a deferred")
                 (catch java.lang.ClassCastException ex
                   (throw (ex-info (str @this ": deferred that breaks everything")
                                   {:cause (str ex)})))))]
    (-> this
        ;; TODO: Write a mirror image version of dns-encode to just show this
        (assoc-in [::server-security ::shared/server-name] "name")
        (assoc-in [::shared/packet-management ::shared/packet] "...packet bytes...")
        (assoc-in [::shared/work-area ::shared/working-nonce] "...FIXME: Decode nonce bytes")
        (assoc-in [::shared/work-area ::shared/text] "...plain/cipher text"))))

(defn extract-child-message
  "Pretty much blindly translated from the CurveCP reference
implementation. This is code that I don't understand yet"
  [this buffer]
  (let [reducer (fn [{:keys [buf
                             buf-len
                             msg
                             msg-len
                             i
                             this]
                      :as acc}
                     b]
                  (when (or (< msg-len 0)
                            ;; This is the flag that the stream has exited.
                            ;; Q: Is that what it's being used for here?
                            (> msg-len 2048))
                    (throw (ex-info "done" {})))
                  ;; It seems silly to set this and then check the first byte
                  ;; for the quit signal (assuming that's what it is)
                  ;; every time through the loop.
                  (aset msg msg-len (aget buf i))
                  (let [msg-len (inc msg-len)
                        length-code (aget msg 0)]
                    (when (bit-and length-code 0x80)
                      (throw (ex-info "done" {})))
                    (if (= msg-len (inc (* 16 length-code)))
                      (let [{:keys [extension
                                    my-keys
                                    packet-management
                                    server-extension
                                    shared-secrets
                                    server-security
                                    text
                                    vouch
                                    work-area]
                             :as this} (state/clientextension-init this)
                            {:keys [::shared/packet
                                    ::shared/packet-nonce]} packet-management
                            _ (throw (RuntimeException. "this Component nonce isn't updated"))
                            short-term-nonce (state/update-client-short-term-nonce
                                              packet-nonce)
                            working-nonce (::shared/working-nonce work-area)]
                        (b-t/uint64-pack! working-nonce K/client-nonce-prefix-length
                                             short-term-nonce)
                        ;; This is where the original splits, depending on whether
                        ;; we've received a message back from the server or not.
                        ;; According to the spec:
                        ;; The server is free to send any number of Message packets
                        ;; after it sees the Initiate packet.
                        ;; The client is free to send any number of Message packets
                        ;; after it sees the server's first Message packet.
                        ;; At this point in time, we know we're still building the
                        ;; Initiate packet.
                        ;; It's tempting to try to avoid duplication the same
                        ;; way the reference implementation does, by handling
                        ;; both logical branches here.
                        ;; And maybe there's a really good reason for doing so.
                        ;; But this function feels far too complex as it is.
                        (let [r (dec msg-len)]
                          (when (or (< r 16)
                                    (> r 640))
                            (throw (ex-info "done" {})))
                          (b-t/byte-copy! working-nonce 0 K/client-nonce-prefix-length
                                          K/initiate-nonce-prefix)
                          ;; Reference version starts by zeroing first 32 bytes.
                          ;; I thought we just needed 16 for the encryption buffer
                          ;; And that doesn't really seem to apply here
                          ;; Q: What's up with this?
                          ;; (it doesn't seem to match the spec, either)
                          (b-t/byte-copy! text 0 32 shared/all-zeros)
                          (b-t/byte-copy! text 32 K/key-length
                                          (.getPublicKey (::shared/long-pair my-keys)))
                          (b-t/byte-copy! text 64 64 vouch)
                          (b-t/byte-copy! text
                                          128
                                          K/server-name-length
                                          (::K/server-name server-security))
                          ;; First byte is a magical length marker
                          ;; TODO: Double-check the original.
                          ;; This doesn't look right at all.
                          ;; I think I need a 32-byte offset for the decryption
                          ;; padding.
                          ;; And the call to open-after really seems like it should start
                          ;; at offset 384 instead of 0
                          (b-t/byte-copy! text 384 r msg 1)
                          (let [box (crypto/open-after (::state/client-short<->server-short shared-secrets)
                                                       text
                                                       0
                                                       (+ r 384)
                                                       working-nonce)
                                offset K/server-nonce-prefix-length]
                            ;; TODO: Switch to compose for this
                            (b-t/byte-copy! packet
                                            0
                                            offset
                                            K/initiate-header)
                            (b-t/byte-copy! packet offset
                                            K/extension-length server-extension)
                            (let [offset (+ offset K/extension-length)]
                              (b-t/byte-copy! packet offset
                                              K/extension-length extension)
                              (let [offset (+ offset K/extension-length)]
                                (b-t/byte-copy! packet offset K/key-length
                                                (.getPublicKey (::shared/short-pair my-keys)))
                                (let [offset (+ offset K/key-length)]
                                  (b-t/byte-copy! packet
                                                  offset
                                                  K/server-cookie-length
                                                  (::state/server-cookie server-security))
                                  (let [offset (+ offset K/server-cookie-length)]
                                    (b-t/byte-copy! packet offset
                                                    K/server-nonce-prefix-length
                                                    working-nonce
                                                    K/server-nonce-suffix-length)))))
                            ;; Original version sends off the packet, updates
                            ;; msg-len to 0, and goes back to pulling data from child/server.
                            (throw (ex-info "How should this really work?"
                                            {:problem "Need to break out of loop here"})))))
                      (assoc acc :msg-len msg-len))))
        extracted (reduce reducer
                          {:buf (byte-array 4096)
                           :buf-len 0
                           :msg (byte-array 2048)
                           :msg-len 0
                           :i 0
                           :this this}
                          buffer)]
    (assoc this ::state/outgoing-message (:child-msg extracted))))

(defn child-exited!
  [this]
  (throw (ex-info "child exited" this)))

(defn hello-failed!
  [this failure]
  (send this #(throw (ex-info "Hello failed"
                              (assoc %
                                     :problem failure)))))

(defn server-closed!
  "This seems pretty meaningless in a UDP context"
  [this]
  (throw (ex-info "Server Closed" this)))

(defn child->server
  "Child sent us (as an agent) a signal to add bytes to the stream to the server"
  [this msg]
  (throw (RuntimeException. "Not translated")))

(defn server->child
  "Received bytes from the server that need to be streamed back to child"
  [this msg]
  (throw (RuntimeException. "Not translated")))

(defn cope-with-successful-hello-creation
  [wrapper chan->server timeout]
  (let [raw-packet (get-in @wrapper
                           [::shared/packet-management
                            ::shared/packet])]
    (log/debug "client/start! Putting" raw-packet "onto" chan->server)
    ;; There's still an important break
    ;; with the reference implementation
    ;; here: this should be sending the
    ;; HELLO packet to multiple server
    ;; end-points to deal with them
    ;; going down.
    ;; I think it's supposed to happen
    ;; in a delayed interval, to give
    ;; each a short time to answer before
    ;; the next, but a major selling point
    ;; is not waiting for TCP buffers
    ;; to expire.
    (let [d (strm/try-put! chan->server
                           raw-packet
                           timeout
                           ::sending-hello-timed-out)]
      (deferred/on-realized d
        (partial cookie/wait-for-cookie wrapper)
        (partial hello-failed! wrapper)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public

(s/fdef start!
        :args (s/cat :this ::state/state-agent)
        ;; Q: Does this return anything meaningful at all?
        ;; A: Well, to remain consistent with the Component workflow,
        ;; it really should return the "started" agent.
        ;; Even though it really is just called for side-effects.
        :ret any?)
(defn start!
  "This almost seems like it belongs in ctor.

But not quite, since it's really the first in a chain of side-effects.

Q: Is there something equivalent I can set up using core.async?

Actually, this seems to be screaming to be rewritten on top of manifold
Deferreds.

For that matter, it seems like setting up a watch on an atom that's
specifically for something like this might make a lot more sense.

That way I wouldn't be trying to multi-purpose communications channels.

OTOH, they *are* the trigger for this sort of thing.

The reference implementation mingles networking with this code.
That seems like it might make sense as an optimization,
but not until I have convincing numbers that it's needed.
Of course, I might also be opening things up for something
like a timing attack."
  [wrapper]
  (when-let [failure (agent-error wrapper)]
    (throw (ex-info "Agent failed before we started"
                    {:problem failure})))

  (let [{:keys [::state/chan->server]} @wrapper
        timeout (state/current-timeout wrapper)]
    (strm/on-drained chan->server
                     (fn []
                       (log/warn "Channel->server closed")
                       (send wrapper server-closed!)))
    ;; This feels inside-out and backwards.
    ;; But it probably should, since this is very
    ;; explicitly place-oriented programming working
    ;; with mutable state.
    (send wrapper hello/do-build-hello)
    (if (await-for timeout wrapper)
      (cope-with-successful-hello-creation wrapper chan->server timeout)
      (throw (ex-info (str "Timed out after " timeout
                           " milliseconds waiting to build HELLO packet")
                      {:problem (agent-error wrapper)})))))

(defn stop!
  [wrapper]
  (if-let [err (agent-error wrapper)]
    (log/error (str err "\nTODO: Is there any way to recover well enough to release the Packet Manager?\n"
                    (util/show-stack-trace err)))
    (send wrapper
          (fn [this]
            (shared/release-packet-manager! (::shared/packet-management this))))))

(s/fdef ctor
        :args (s/keys :req [::state/chan<-server
                            ::state/chan->server
                            ::shared/my-keys
                            ::state/server-security])
        :ret ::state/state-agent)
(defn ctor
  [opts]
  (-> opts
      state/initialize-immutable-values
      state/initialize-mutable-state!
      (assoc
       ;; This seems very cheese-ball, but they
       ;; *do* need to be part of the agent.
       ;; We definitely don't want multiple threads
       ;; messing with them
       ::shared/packet-management (shared/default-packet-manager)
       ::shared/work-area (shared/default-work-area))
      ;; Using a core.async go-loop is almost guaranteed
      ;; to be faster.
      ;; TODO: Verify the "almost" with numbers.
      ;; The more I try to switching, the more dubious this
      ;; approach seems.
      ;; pipelines might not make a lot of sense on the client,
      ;; since they're at least theoretically about increasing
      ;; throughput at the expense of latency.
      ;; But they probably make a lot of sense on some servers.
      agent))

Clean up errors left over from client refactor

When I broke it into multiple namespaces, I didn't fix the names of all
the pieces that moved.


(ns scrape-trs.core
  (:require [clojure.string :as string]
            [scrape-trs.cascade-climbers.core :as cc]
            [scrape-trs.summitpost.core :as sp]))

(def ^:private implementations
  {cc/base-url (cc/->CCScrapeTripReport)
   sp/base-url (sp/->SPScrapeTripReport)})

(defn list-supported-urls
  "Return a sequence of the base urls of all sites with trip report scrapers."
  []
  (keys implementations))

(defn- get-implementation
  "Given a url whose base is in (list-supported-urls), return an
  implementation of scrape-trs.protocol/ScrapeTripReport."
  [url]
  (second (first (filter #(string/starts-with? url (key %)) implementations))))

(defn get-trip-reports
  "
  url: url of list-page or the site it was retrieved from. Must correspond to
       a supported url in (list-supported-urls).
  list-page: page (as a string) that lists trip reports

  Scrape all trip reports from the list-page, paging through pagination if
  necessary, and return a sequence of scrape-trs.protocol/TripReport
  instances."
  [url list-page]
  (let [implementation (get-implementation url)
        pager-urls (.extract-pager-urls implementation list-page)
        list-pages (if pager-urls (map slurp pager-urls) [list-page])
        trip-report-urls (mapcat #(.extract-trip-report-urls implementation %)
                                 list-pages)
        trip-reports (map #(.extract-trip-report implementation %1 %2)
                          trip-report-urls
                          (map slurp trip-report-urls))]
    trip-reports))

(ns scrape-trs.core
  (:require [clojure.string :as string]
            [scrape-trs.cascade-climbers.core :as cc]
            [scrape-trs.summitpost.core :as sp]))

(def ^:private implementations
  {cc/base-url (cc/->CCScrapeTripReport)
   sp/base-url (sp/->SPScrapeTripReport)})

(defn list-supported-urls
  "Return a sequence of the base urls of all sites with trip report scrapers."
  []
  (keys implementations))

(defn- get-implementation
  "Given a url whose base is in (list-supported-urls), return an
  implementation of scrape-trs.protocol/ScrapeTripReport."
  [url]
  (second (first (filter #(string/starts-with? url (key %)) implementations))))

(defn get-trip-reports
  "
  url: url of list-page or the site it was retrieved from. Must correspond to
       a supported url in (list-supported-urls).
  list-page: page (as a string) that lists trip reports

  Scrape all trip reports from the list-page, paging through pagination if
  necessary, and return a lazy sequence of scrape-trs.protocol/TripReport
  instances."
  [url list-page]
  (let [implementation (get-implementation url)
        pager-urls (.extract-pager-urls implementation list-page)
        list-pages (if pager-urls (map slurp pager-urls) [list-page])
        trip-report-urls (mapcat #(.extract-trip-report-urls implementation %)
                                 list-pages)
        trip-reports (map #(.extract-trip-report implementation %1 %2)
                          trip-report-urls
                          (map slurp trip-report-urls))]
    trip-reports))

Clarify that sequence of trip reports is lazy.