| 1 | ;;; emms-librefm-scrobbler.el --- Libre.FM Scrobbing API -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2014, 2025 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Yoni Rabkin <yrk@gnu.org> |
| 6 | |
| 7 | ;; Keywords: emms, libre.fm, GNU FM |
| 8 | |
| 9 | ;; EMMS is free software; you can redistribute it and/or modify it |
| 10 | ;; under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. |
| 13 | ;; |
| 14 | ;; EMMS is distributed in the hope that it will be useful, but WITHOUT |
| 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
| 16 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
| 17 | ;; License for more details. |
| 18 | ;; |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with EMMS; see the file COPYING. If not, write to the Free |
| 21 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, |
| 22 | ;; MA 02110-1301, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; To use libre.fm you need to add username and password to |
| 27 | ;; ~/.authinfo.gpg or an equivalent file understood by auth-source. |
| 28 | ;; To enable scrobbling call (emms-librefm-scrobbler-enable). |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | (require 'emms-playing-time) |
| 33 | (require 'auth-source) |
| 34 | (require 'url-vars) |
| 35 | |
| 36 | |
| 37 | (defvar emms-librefm-scrobbler-handshake-url |
| 38 | "turtle.libre.fm" |
| 39 | "Endpoint for client handshake.") |
| 40 | |
| 41 | (defvar emms-librefm-scrobbler-method |
| 42 | "https" |
| 43 | "Transfer method.") |
| 44 | |
| 45 | (defvar emms-librefm-scrobbler-username nil |
| 46 | "Libre.fm username. |
| 47 | |
| 48 | Note that the preferred way of authenticating is using authinfo |
| 49 | and only setting `emms-librefm-scrobbler-handshake-url'. See the |
| 50 | manual for details.") |
| 51 | |
| 52 | (defvar emms-librefm-scrobbler-password nil |
| 53 | "Libre.fm user password. |
| 54 | |
| 55 | Note that the preferred way of authenticating is using authinfo. |
| 56 | See also `emms-librefm-scrobbler-username'.") |
| 57 | |
| 58 | (defvar emms-librefm-scrobbler-debug |
| 59 | "" |
| 60 | "Debugging variable to store communication.") |
| 61 | |
| 62 | (defvar emms-librefm-scrobbler-session-id |
| 63 | nil |
| 64 | "Session ID for Libre.fm.") |
| 65 | |
| 66 | (defvar emms-librefm-scrobbler-now-playing-url |
| 67 | "" |
| 68 | "URL for getting the track playing.") |
| 69 | |
| 70 | (defvar emms-librefm-scrobbler-submission-url |
| 71 | "" |
| 72 | "URL for submissions.") |
| 73 | |
| 74 | (defvar emms-librefm-scrobbler-track-play-start-timestamp |
| 75 | nil |
| 76 | "Time when a track started playing.") |
| 77 | |
| 78 | (defvar emms-librefm-scrobbler-display-submissions |
| 79 | t |
| 80 | "Whether to display a user message on every submission.") |
| 81 | |
| 82 | |
| 83 | ;;; ------------------------------------------------------------------ |
| 84 | ;;; authenticate |
| 85 | ;;; ------------------------------------------------------------------ |
| 86 | (defun emms-librefm-scrobbler--get-auth-detail (token) |
| 87 | "Return TOKEN from auth-source. |
| 88 | TOKEN is :user of :secret." |
| 89 | ;; TODO: Maybe we should enable :create t here. But it could be |
| 90 | ;; kind of annoying as it makes a pop-up when no name is present. |
| 91 | (plist-get |
| 92 | (car (auth-source-search :host (list emms-librefm-scrobbler-handshake-url "libre.fm") |
| 93 | :user (unless (equal emms-librefm-scrobbler-username "") |
| 94 | emms-librefm-scrobbler-username) |
| 95 | :max 1 :require '(:user :secret))) |
| 96 | token)) |
| 97 | |
| 98 | (defun emms-librefm-scrobbler--username () |
| 99 | "Return username for libre.fm." |
| 100 | (or (emms-librefm-scrobbler--get-auth-detail :user) |
| 101 | emms-librefm-scrobbler-username)) |
| 102 | |
| 103 | (defun emms-librefm-scrobbler--password () |
| 104 | "Return password for libre.fm." |
| 105 | (let ((token (emms-librefm-scrobbler--get-auth-detail :secret))) |
| 106 | (cond ((functionp token) (funcall token)) |
| 107 | ((characterp token) token) |
| 108 | (t emms-librefm-scrobbler-password)))) |
| 109 | |
| 110 | ;;; ------------------------------------------------------------------ |
| 111 | ;;; handshake |
| 112 | ;;; ------------------------------------------------------------------ |
| 113 | |
| 114 | (defun emms-librefm-scrobbler-handshake-string (url username password) |
| 115 | "Return the client handshake string." |
| 116 | (when (= 0 (length url)) |
| 117 | (error "bad url")) |
| 118 | (when (= 0 (length username)) |
| 119 | (error "bad username")) |
| 120 | (when (= 0 (length password)) |
| 121 | (error "bad password")) |
| 122 | (let ((timestamp (format-time-string "%s"))) |
| 123 | (concat emms-librefm-scrobbler-method |
| 124 | "://" |
| 125 | url "/?" |
| 126 | "hs=true" "&" |
| 127 | "p=1.2" "&" |
| 128 | "c=emm" "&" |
| 129 | "v=1.0" "&" |
| 130 | "u=" (url-encode-url username) "&" |
| 131 | "t=" timestamp "&" |
| 132 | "a=" (md5 (concat (md5 password) timestamp))))) |
| 133 | |
| 134 | (defun emms-librefm-scrobbler-handshake-call (url username password) |
| 135 | "Perform client handshake and return a response in a buffer." |
| 136 | (let ((url-request-method "POST")) |
| 137 | (ignore url-request-method) |
| 138 | (let ((response |
| 139 | (url-retrieve-synchronously |
| 140 | (emms-librefm-scrobbler-handshake-string |
| 141 | url username password)))) |
| 142 | (setq emms-librefm-scrobbler-debug |
| 143 | (with-current-buffer response |
| 144 | (buffer-substring-no-properties (point-min) |
| 145 | (point-max)))) |
| 146 | response))) |
| 147 | |
| 148 | (defun emms-librefm-scrobbler-handle-handshake-response (resbuf) |
| 149 | "Handle the client handshake server response." |
| 150 | (when (not (bufferp resbuf)) |
| 151 | (error "response not a buffer")) |
| 152 | (with-current-buffer resbuf |
| 153 | (goto-char (point-min)) |
| 154 | (when (not (re-search-forward "^.*200 OK$" (line-end-position) t)) |
| 155 | (error "bad HTTP server response")) |
| 156 | ;; go to the start of the FM response |
| 157 | (when (not (re-search-forward "\n\n" (point-max) t)) |
| 158 | (error "bad FM server response")) |
| 159 | (let ((status (buffer-substring (line-beginning-position) |
| 160 | (line-end-position)))) |
| 161 | (when (not (string= status "OK")) |
| 162 | (error "FM server returned: %s" status)) |
| 163 | (let (session-id |
| 164 | now-playing-url |
| 165 | submission-url) |
| 166 | (forward-line 1) |
| 167 | (setq session-id (buffer-substring (line-beginning-position) |
| 168 | (line-end-position))) |
| 169 | (forward-line 1) |
| 170 | (setq now-playing-url (buffer-substring (line-beginning-position) |
| 171 | (line-end-position))) |
| 172 | (forward-line 1) |
| 173 | (setq submission-url (buffer-substring (line-beginning-position) |
| 174 | (line-end-position))) |
| 175 | (when (or (= 0 (length session-id)) |
| 176 | (= 0 (length now-playing-url)) |
| 177 | (= 0 (length submission-url))) |
| 178 | (error "couldn't parse FM server response")) |
| 179 | (setq emms-librefm-scrobbler-session-id session-id |
| 180 | emms-librefm-scrobbler-now-playing-url now-playing-url |
| 181 | emms-librefm-scrobbler-submission-url submission-url) |
| 182 | (message "handshake successful"))))) |
| 183 | |
| 184 | (defun emms-librefm-scrobbler-handshake () |
| 185 | "Perform client handshake call and handle response." |
| 186 | (emms-librefm-scrobbler-handle-handshake-response |
| 187 | (emms-librefm-scrobbler-handshake-call |
| 188 | emms-librefm-scrobbler-handshake-url |
| 189 | (emms-librefm-scrobbler--username) |
| 190 | (emms-librefm-scrobbler--password)))) |
| 191 | |
| 192 | |
| 193 | ;;; ------------------------------------------------------------------ |
| 194 | ;;; submission |
| 195 | ;;; ------------------------------------------------------------------ |
| 196 | |
| 197 | (defun emms-librefm-scrobbler-make-query (track rating) |
| 198 | "Format the url parameters for scrobbling." |
| 199 | (setq rating |
| 200 | (cond ((equal 'love rating) "L") |
| 201 | ((equal 'ban rating) "B") |
| 202 | ((equal 'skip rating) "S") |
| 203 | (t ""))) |
| 204 | (let ((artist (emms-track-get track 'info-artist)) |
| 205 | (title (emms-track-get track 'info-title)) |
| 206 | (album (or (emms-track-get track 'info-album) "")) |
| 207 | (track-number (emms-track-get track 'info-tracknumber)) |
| 208 | (musicbrainz-id "") |
| 209 | (track-length (number-to-string |
| 210 | (or (emms-track-get track |
| 211 | 'info-playing-time) |
| 212 | 0)))) |
| 213 | (if (and artist title) |
| 214 | (concat |
| 215 | "s=" emms-librefm-scrobbler-session-id |
| 216 | "&a[0]=" (url-encode-url artist) |
| 217 | "&t[0]=" (url-encode-url title) |
| 218 | "&i[0]=" (url-encode-url |
| 219 | (or emms-librefm-scrobbler-track-play-start-timestamp |
| 220 | (format-time-string "%s"))) |
| 221 | "&o[0]=" "P" |
| 222 | "&r[0]=" (url-encode-url rating) |
| 223 | "&l[0]=" track-length |
| 224 | "&b[0]=" (url-encode-url album) |
| 225 | "&n[0]=" track-number |
| 226 | "&m[0]=" musicbrainz-id) |
| 227 | (error "Track title and artist must be known.")))) |
| 228 | |
| 229 | |
| 230 | ;;; ------------------------------------------------------------------ |
| 231 | ;;; asynchronous submission |
| 232 | ;;; ------------------------------------------------------------------ |
| 233 | |
| 234 | (defun emms-librefm-scrobbler-get-response-status () |
| 235 | "Check the HTTP header and return the body." |
| 236 | (let ((ok200 "HTTP/1.1 200 OK")) |
| 237 | (if (< (point-max) 1) |
| 238 | (error "No response from submission server")) |
| 239 | (if (not (string= ok200 (buffer-substring-no-properties (point-min) 16))) |
| 240 | (error "submission server not responding correctly")) |
| 241 | (goto-char (point-min)) |
| 242 | (re-search-forward "\n\n") |
| 243 | (buffer-substring-no-properties |
| 244 | (line-beginning-position) (line-end-position)))) |
| 245 | |
| 246 | (defun emms-librefm-scrobbler-make-async-submission-call (track rating) |
| 247 | "Make asynchronous submission call." |
| 248 | (let ((flarb (emms-librefm-scrobbler-make-query track rating))) |
| 249 | (let* ((url-request-method "POST") |
| 250 | (url-request-data flarb) |
| 251 | (url-request-extra-headers |
| 252 | `(("Content-type" . "application/x-www-form-urlencoded")))) |
| 253 | (ignore url-request-extra-headers |
| 254 | url-request-data |
| 255 | url-request-method) |
| 256 | (url-retrieve emms-librefm-scrobbler-submission-url |
| 257 | #'emms-librefm-scrobbler-async-submission-callback |
| 258 | (list (cons track rating)))))) |
| 259 | |
| 260 | (defun emms-librefm-scrobbler-async-submission-callback (status &optional cbargs) |
| 261 | "Pass response of asynchronous submission call to handler." |
| 262 | (let ((response (emms-librefm-scrobbler-get-response-status))) |
| 263 | (ignore status) |
| 264 | ;; From the API docs: This indicates that the |
| 265 | ;; submission request was accepted for processing. It |
| 266 | ;; does not mean that the submission was valid, but |
| 267 | ;; only that the authentication and the form of the |
| 268 | ;; submission was validated. |
| 269 | (let ((track (car cbargs))) |
| 270 | (cond ((string= response "OK") |
| 271 | (when emms-librefm-scrobbler-display-submissions |
| 272 | (message "Libre.fm: Submitted %s" |
| 273 | (emms-track-get track 'info-title)))) |
| 274 | ((string= response "BADSESSION") |
| 275 | (emms-librefm-scrobbler-handshake) |
| 276 | (emms-librefm-scrobbler-make-async-submission-call (car cbargs) (cdr cbargs))) |
| 277 | (t |
| 278 | (error "unhandled submission failure")))))) |
| 279 | |
| 280 | |
| 281 | ;;; ------------------------------------------------------------------ |
| 282 | ;;; hooks |
| 283 | ;;; ------------------------------------------------------------------ |
| 284 | |
| 285 | (defun emms-librefm-scrobbler-start-hook () |
| 286 | (setq emms-librefm-scrobbler-track-play-start-timestamp |
| 287 | (format-time-string "%s"))) |
| 288 | |
| 289 | (defun emms-librefm-scrobbler-stop-hook () |
| 290 | "Submit the track to libre.fm if it has been played for 240 |
| 291 | seconds or half the length of the track." |
| 292 | (let ((current-track (emms-playlist-current-selected-track))) |
| 293 | (let ((track-length (emms-track-get current-track 'info-playing-time))) |
| 294 | (when (and track-length |
| 295 | ;; only submit files |
| 296 | (eq (emms-track-type current-track) 'file)) |
| 297 | (when (and |
| 298 | ;; track must be longer than 30 secs |
| 299 | (> track-length 30) |
| 300 | ;; track must be played for more than 240 secs or |
| 301 | ;; half the tracks length, whichever comes first. |
| 302 | (> emms-playing-time (min 240 (/ track-length 2)))) |
| 303 | (emms-librefm-scrobbler-make-async-submission-call |
| 304 | current-track nil)))))) |
| 305 | |
| 306 | (defun emms-librefm-scrobbler-enable () |
| 307 | "Enable the scrobbler and submit played tracks." |
| 308 | (interactive) |
| 309 | (unless emms-playing-time-mode (error "scrobbler: please activate emms-playing-time-mode")) |
| 310 | (when (not emms-librefm-scrobbler-session-id) |
| 311 | (emms-librefm-scrobbler-handshake)) |
| 312 | (add-hook 'emms-player-started-hook |
| 313 | 'emms-librefm-scrobbler-start-hook t) |
| 314 | (add-hook 'emms-player-stopped-hook |
| 315 | 'emms-librefm-scrobbler-stop-hook) |
| 316 | (add-hook 'emms-player-finished-hook |
| 317 | 'emms-librefm-scrobbler-stop-hook)) |
| 318 | |
| 319 | (defun emms-librefm-scrobbler-disable () |
| 320 | "Disable the scrobbler and don't submit played tracks." |
| 321 | (interactive) |
| 322 | (setq emms-librefm-scrobbler-session-id nil) |
| 323 | (remove-hook 'emms-player-started-hook |
| 324 | 'emms-librefm-scrobbler-start-hook) |
| 325 | (remove-hook 'emms-player-stopped-hook |
| 326 | 'emms-librefm-scrobbler-stop-hook) |
| 327 | (remove-hook 'emms-player-finished-hook |
| 328 | 'emms-librefm-scrobbler-stop-hook)) |
| 329 | |
| 330 | |
| 331 | (provide 'emms-librefm-scrobbler) |
| 332 | |
| 333 | |
| 334 | ;;; emms-librefm-scrobbler.el ends here |