Coverage report: /home/ellis/comp/core/lib/cli/tools/net.lisp

Kind	Covered	All	%
expression	0	496	0.0
branch	0	26	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; net.lisp --- Net Tools

2

3

;;

4

5

;;; Code:

6

(in-package :cli/tools/net)

7

8

;;; Browser

9

(deferror simple-browser-error (simple-error) () (:auto t))

10

11

(defparameter *browser* (or (find-exe "chromium") (find-exe "firefox")))

12

13

(defun run-browser (&rest args)

14

(let ((proc (sb-ext:run-program *browser* (or args nil) :output :stream)))

15

(with-open-stream (s (sb-ext:process-output proc))

16

(loop for l = (read-line s nil nil)

17

while l

18

do (write-line l)))

19

(if (eq 0 (sb-ext:process-exit-code proc))

20

nil

21

(simple-browser-error "browser command failed: ~A ~A" args))))

22

23

(defun browse-url (url)

24

(run-browser (render-uri url)))

25

26

(defconfig browser-config (ast) ())

27

28

(defconfig chromium-config (browser-config) ())

29

30

(defmethod make-config ((obj (eql :chromium)) &key ast)

31

(make-instance 'chromium-config :ast ast))

32

33

(defconfig firefox-config (browser-config) ())

34

35

(defmethod make-config ((obj (eql :firefox)) &key ast)

36

(make-instance 'firefox-config :ast ast))

37

38

;;; IP

39

(define-cli-tool :ip (&rest args)

40

(let ((proc (sb-ext:run-program *ip* (or args nil) :output :stream)))

41

(with-open-stream (s (sb-ext:process-output proc))

42

(loop for l = (read-line s nil nil)

43

while l

44

do (write-line l)))

45

(if (eq 0 (sb-ext:process-exit-code proc))

46

nil

47

(ip-error "ip command failed: ~A ~A" args))))

48

49

(defun ip-link-add (dev &optional (type "wireguard"))

50

(run-ip "link" "add" "dev" dev "type" type))

51

52

(defun ip-link-up (dev)

53

(run-ip "link" "set" "up" "dev" dev))

54

55

(defun ip-addr-add (dev addr &optional peer)

56

(apply 'run-ip "address" "add" "dev" dev addr (when peer (list "peer" peer))))

57

58

;;; Wireguard

59

(deferror wg-error (simple-error error) () (:auto t))

60

61

(defparameter *wg* (find-exe "wg"))

62

63

(defun run-wg* (args &optional (output *standard-output*) input)

64

(let ((proc (if input

65

(sb-ext:run-program *wg* (or args nil) :output :stream :input input)

66

(sb-ext:run-program *wg* (or args nil) :output :stream))))

67

(with-open-stream (s (sb-ext:process-output proc))

68

(loop for l = (read-line s nil nil)

69

while l

70

do (write-string l output)))

71

(if (eq 0 (sb-ext:process-exit-code proc))

72

nil

73

(wg-error "WG command failed: ~A ~A" *wg* (or args "")))))

74

75

(defun run-wg (&rest args)

76

(run-wg* args))

77

78

(when *wg* (pushnew :wg *cli-tools*))

79

80

(defun wg-private-key ()

81

(with-output-to-string (s)

82

(run-wg* '("genkey") s)))

83

84

(defun wg-public-key (private-key)

85

(with-output-to-string (public-key)

86

(with-input-from-string (s private-key)

87

(run-wg* '("pubkey") public-key s))))

88

89

(defun wg-generate-keys ()

90

"Generate a wireguard keypair, returning (values PUBLIC-KEY PRIVATE-KEY)."

91

(let* ((privkey (wg-private-key))

92

(pubkey (wg-public-key privkey)))

93

(values pubkey privkey)))

94

95

(defun wg-generate-key-files (&optional (private "private.key") (public "public.key"))

96

(multiple-value-bind (pubkey privkey) (wg-generate-keys)

97

(with-umask #o077

98

(log:trace! "setting umask to 077")

99

(with-open-file (f public :direction :output)

100

(write-line pubkey f))

101

(with-open-file (f private :direction :output)

102

(write-line privkey f)))))

103

104

(defun wg-setconf (dev conf)

105

(run-wg "setconf" dev conf))

106

107

(defun wg-set (dev &key listen-port private-key peer allowed-ips endpoint)

108

(let ((args (list "set" dev)))

109

(when listen-port (appendf args (list listen-port "listen-port")))

110

(when private-key (appendf args (list private-key "private-key")))

111

(when peer (appendf args (list peer "peer")))

112

(when allowed-ips (appendf args (list allowed-ips "allowed-ips")))

113

(when endpoint (appendf args (list endpoint "endpoint")))

114

(apply 'run-wg args)))

115

116

(defun wg-show (dev)

117

(run-wg "show" dev))

118

119

(defun wg-showconf (conf)

120

(run-wg "showconf" conf))

121

122

;;; DNSMASQ

123

(define-cli-tool :dnsmasq (&rest args)

124

(let ((proc (sb-ext:run-program *dnsmasq* (or args nil) :output t)))

125

(unless (eq 0 (sb-ext:process-exit-code proc))

126

(dnsmasq-error "dnsmasq command failed: ~A" args))))

127

128

(defconfig dnsmasq-config (ini-document) ())

129

130

(defmethod deserialize ((self t) (fmt (eql :dnsmasq-config)) &key)

131

(change-class (deserialize self :ini) 'dnsmasq-config))

132

133

(defun load-dnsmasq-config (&optional (path #p"/etc/dnsmasq.conf"))

134

(deserialize path :dnsmasq-config))

135

136

;;; EASYRSA

137

(defvar *easy-rsa-directory* #p"/etc/easy-rsa/")

138

(defvar *easy-rsa-vars-file* (merge-pathnames "vars" *easy-rsa-directory*))

139

140

(define-cli-tool :easyrsa (&rest args)

141

(let ((proc (sb-ext:run-program *easyrsa* (or args nil) :output t)))

142

(unless (not (eq 0 (sb-ext:process-exit-code proc)))

143

(easyrsa-error "easyrsa command failed: ~A " args))))

144

145

(definline easyrsa-init-pki (&key (use-algo "ed") (curve "ed25519") (digest "sha512"))

146

(let ((args `(,@(when use-algo `("--use-algo" ,use-algo))

147

,@(when curve `("--curve" ,curve))

148

,@(when digest `("--digest" ,digest)))))

149

(apply 'run-easyrsa "init-pki" args)))

150

151

(definline easyrsa-build-ca ()

152

(run-easyrsa "build-ca"))

153

154

(definline easyrsa-gen-req (name &rest cmd-opts)

155

(apply 'run-easyrsa "gen-req" name cmd-opts))

156

157

;;; NMAP

158

(deferror nmap-error (simple-error error) () (:auto t))

159

160

(defvar *nmap* (find-exe "nmap"))

161

162

(defun run-nmap* (args &optional (output *standard-output*) input)

163

(let ((proc (if input

164

(sb-ext:run-program *nmap* (or args nil) :output output :input input)

165

(sb-ext:run-program *nmap* (or args nil) :output output))))

166

(if (eq 0 (sb-ext:process-exit-code proc))

167

nil

168

(nmap-error "NMAP command failed: ~A ~A" *nmap* (or args "")))))

169

170

(defun run-nmap (&rest args)

171

(run-nmap* args))

172

173

(when *nmap* (pushnew :nmap *cli-tools*))

174

175

;;; YTDL

176

;; ref: https://github.com/yt-dlp/yt-dlp

177

(defconfig ytdl-config (ast) ())

178

179

(defvar *ytdl-user-config-directory* (merge-homedir-pathnames ".config/yt-dlp/"))

180

181

(defmethod make-config ((self (eql :ytdl)) &rest args)

182

(if-let ((ast (getf args :ast)))

183

(progn

184

(remf args :ast)

185

       (apply 'make-instance 'ytdl-config :ast (remove-if (lambda (x) (char= #\# (schar x 0))) ast) args))

186

(apply 'make-instance 'ytdl-config args)))

187

188

(defun load-ytdl-config (&optional (path (merge-pathnames "yt-dlp.conf" *ytdl-user-config-directory*)))

189

(when (probe-file path)

190

(make-config :ytdl :ast (uiop:read-file-lines path))))

191

192

(deferror ytdl-error (simple-error error) () (:auto t))

193

194

(defvar *ytdl* (find-exe "yt-dlp"))

195

196

(defmacro with-ytdl ((args &optional output proc input) &body body)

197

(with-gensyms (s)

198

`(let ((,(or proc s)

199

(if ,input

200

(sb-ext:run-program *ytdl* ,(or args nil) :output ,output :input ,input)

201

(sb-ext:run-program *ytdl* ,(or args nil) :output ,output))))

202

(unwind-protect (progn ,@body)

203

(unless (eq 0 (sb-ext:process-exit-code ,(or proc s)))

204

nil

205

(ytdl-error "YTDL command failed: ~A ~A" *ytdl* ,(or args "")))))))

206

207

(defun run-ytdl (&rest args)

208

(with-ytdl (args *standard-output*)))

209

210

(defun ytdl-extractors ()

211

"Return the list of available YTDL extractors."

212

(mapcar

213

'trim

214

(lines

215

(with-output-to-string (s)

216

(with-ytdl ((list "--list-extractors") s))))))

217

218

(defun ytdl-user-agent ()

219

"Return the current YTDL user-agent."

220

(trim

221

(with-output-to-string (s)

222

(with-ytdl ((list "--dump-user-agent") s)))))

223

224

(defun ytdl-list (playlist)

225

"Return a list of matches for given PLAYLIST."

226

(mapcar

227

'trim

228

(lines

229

(with-output-to-string (s)

230

(with-ytdl (`("--flat-playlist" "--print" "id" ,playlist) s))))))

231

232

(defun ytdl-json (query)

233

"Return the infojson for a given track or playlist QUERY."

234

(deserialize

235

(with-output-to-string (s)

236

(with-ytdl (`("--dump-json" ,query) s)))

237

:json))

238

239

;;; Caddy

240

(deferror caddy-error (simple-error error) () (:auto t))

241

242

(defvar *caddy* (find-exe "caddy"))

243

244

(defun run-caddy* (args &optional (output *standard-output*))

245

(let ((proc (sb-ext:run-program *caddy* (or (flatten args) nil) :output output)))

246

(if (eq 0 (sb-ext:process-exit-code proc))

247

nil

248

(caddy-error "CADDY command failed: ~A ~A" *caddy* (or args "")))))

249

250

(defun run-caddy (&rest args)

251

(run-caddy* args))

252

253

(defun start-caddy (&rest args)

254

(apply 'run-caddy "start" args))

255

256

(when *caddy* (pushnew :caddy *cli-tools*))

257

258

#|

259

(start-caddy)

260

261

(req:post "http://127.0.0.1:2019/load" :headers '(("Content-Type" . "application/json")) :content " {

262

\"apps\": {

263

\"http\": {

264

\"servers\": {

265

\"hello\": {

266

\"listen\": [\":2015\"],

267

\"routes\": [

268

{

269

\"handle\": [{

270

\"handler\": \"static_response\",

271

\"body\": \"Hello, world!\"

272

}]

273

}

274

]

275

}

276

}

277

}

278

}

279

}")

280

281

;; OK

282

283

(req:get "http://127.0.0.1:2015") ;; Hello, world!

284

|#

285

286

;;; Transmission

287

288

#| env

289

TR_APP_VERSION ; Transmission's short version string, e.g. 4.0.0

290

TR_TIME_LOCALTIME

291

TR_TORRENT_BYTES_DOWNLOADED ; Number of bytes that were downloaded for this torrent

292

TR_TORRENT_DIR ; Location of the downloaded data

293

TR_TORRENT_HASH ; The torrent's info hash

294

TR_TORRENT_ID

295

TR_TORRENT_LABELS ; A comma-delimited list of the torrent's labels

296

TR_TORRENT_NAME ; Name of torrent (not filename)

297

TR_TORRENT_PRIORITY ; The priority of the torrent (Low is "-1", Normal is "0", High is "1")

298

TR_TORRENT_TRACKERS ; A comma-delimited list of the torrent's trackers' announce URLs

299

|#

300

301

(defvar *transmission-user-config-directory* (merge-homedir-pathnames ".config/transmission/"))

302

303

(defconfig transmission-config ()

304

((settings :initarg :settings :type transmission-settings)))

305

306

(defconfig transmission-settings (json:json-object) ())

307

308

(defmethod make-config ((obj (eql :transmission)) &key settings)

309

(make-instance 'transmission-config :settings settings))

310

311

(defun load-transmission-config (&optional (path *transmission-user-config-directory*))

312

(when (probe-file path)

313

(make-config :transmission

314

:settings (change-class

315

(deserialize (merge-pathnames "settings.json" path) :json)

316

'transmission-settings))))

317

318

(define-cli-tool :transmission-remote (args &key (wait t) (output t))

319

(let ((proc (sb-ext:run-program *transmission-remote* args :wait wait :output output)))

320

(unless (eq 0 (sb-ext:process-exit-code proc))

321

       (transmission-remote-error "TRANSMISSION-REMOTE command failed: ~A ~A" *transmission-remote* (or args "")))))

322

323

(define-cli-tool :transmission-daemon (args &key (wait t) (output t))

324

(let ((proc (sb-ext:run-program *transmission-daemon* args :wait wait :output output)))

325

(unless (eq 0 (sb-ext:process-exit-code proc))

326

       (transmission-daemon-error "TRANSMISSION-DAEMON command failed: ~A ~A" *transmission-daemon* (or args "")))))

327

328

(define-cli-tool :rsync (args &key (output t) (wait t) (input t))

329

(let ((proc (sb-ext:run-program *rsync* args :wait wait :output output :input input)))

330

(unless (eq 0 (sb-ext:process-exit-code proc))

331

(rsync-error "RSYNC command failed: ~A ~A" *rsync* (or args "")))))