blob: eb4f175a6e7e822df244894786c1bb15e09be1e7 (
plain) (
tree)
|
|
;;; emms-librefm-scrobbler.el --- Libre.FM Scrobbing API -*- lexical-binding: t; -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Yoni Rabkin <yrk@gnu.org>
;; Keywords: emms, libre.fm, GNU FM
;; EMMS is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; EMMS is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
;; License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with EMMS; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301, USA.
;;; Commentary:
;; To use libre.fm you need to add username and password to
;; ~/.authinfo.gpg or an equivalent file understood by auth-source.
;; To enable scrobbling call (emms-librefm-scrobbler-enable).
;;; Code:
(require 'emms-playing-time)
(require 'auth-source)
(defvar emms-librefm-scrobbler-handshake-url
"turtle.libre.fm"
"Endpoint for client handshake.")
(defvar emms-librefm-scrobbler-method
"https"
"Transfer method.")
(defvar emms-librefm-scrobbler-username nil
"Libre.fm username.
Note that the preferred way of authenticating is using authinfo
and only setting `emms-librefm-scrobbler-handshake-url'. See the
manual for details.")
(defvar emms-librefm-scrobbler-password nil
"Libre.fm user password.
Note that the preferred way of authenticating is using authinfo.
See also `emms-librefm-scrobbler-username'.")
(defvar emms-librefm-scrobbler-debug
""
"Debugging variable to store communication.")
(defvar emms-librefm-scrobbler-session-id
nil
"Session ID for Libre.fm.")
(defvar emms-librefm-scrobbler-now-playing-url
""
"URL for getting the track playing.")
(defvar emms-librefm-scrobbler-submission-url
""
"URL for submissions.")
(defvar emms-librefm-scrobbler-track-play-start-timestamp
nil
"Time when a track started playing.")
(defvar emms-librefm-scrobbler-display-submissions
t
"Whether to display a user message on every submission.")
;;; ------------------------------------------------------------------
;;; authenticate
;;; ------------------------------------------------------------------
(defun emms-librefm-scrobbler--get-auth-detail (token)
"Return TOKEN from auth-source.
TOKEN is :user of :secret."
;; TODO: Maybe we should enable :create t here. But it could be
;; kind of annoying as it makes a pop-up when no name is present.
(plist-get
(car (auth-source-search :host (list emms-librefm-scrobbler-handshake-url "libre.fm")
:user (unless (equal emms-librefm-scrobbler-username "")
emms-librefm-scrobbler-username)
:max 1 :require '(:user :secret)))
token))
(defun emms-librefm-scrobbler--username ()
"Return username for libre.fm."
(or (emms-librefm-scrobbler--get-auth-detail :user)
emms-librefm-scrobbler-username))
(defun emms-librefm-scrobbler--password ()
"Return password for libre.fm."
(let ((token (emms-librefm-scrobbler--get-auth-detail :secret)))
(cond ((functionp token) (funcall token))
((characterp token) token)
(t emms-librefm-scrobbler-password))))
;;; ------------------------------------------------------------------
;;; handshake
;;; ------------------------------------------------------------------
(defun emms-librefm-scrobbler-handshake-string (url username password)
"Return the client handshake string."
(when (= 0 (length url))
(error "bad url"))
(when (= 0 (length username))
(error "bad username"))
(when (= 0 (length password))
(error "bad password"))
(let ((timestamp (format-time-string "%s")))
(concat emms-librefm-scrobbler-method
"://"
url "/?"
"hs=true" "&"
"p=1.2" "&"
"c=emm" "&"
"v=1.0" "&"
"u=" (url-encode-url username) "&"
"t=" timestamp "&"
"a=" (md5 (concat (md5 password) timestamp)))))
(defun emms-librefm-scrobbler-handshake-call (url username password)
"Perform client handshake and return a response in a buffer."
(let ((url-request-method "POST"))
(ignore url-request-method)
(let ((response
(url-retrieve-synchronously
(emms-librefm-scrobbler-handshake-string
url username password))))
(setq emms-librefm-scrobbler-debug
(with-current-buffer response
(buffer-substring-no-properties (point-min)
(point-max))))
response)))
(defun emms-librefm-scrobbler-handle-handshake-response (resbuf)
"Handle the client handshake server response."
(when (not (bufferp resbuf))
(error "response not a buffer"))
(with-current-buffer resbuf
(goto-char (point-min))
(when (not (re-search-forward "^.*200 OK$" (point-at-eol) t))
(error "bad HTTP server response"))
;; go to the start of the FM response
(when (not (re-search-forward "\n\n" (point-max) t))
(error "bad FM server response"))
(let ((status (buffer-substring (point-at-bol)
(point-at-eol))))
(when (not (string= status "OK"))
(error "FM server returned: %s" status))
(let (session-id
now-playing-url
submission-url)
(forward-line 1)
(setq session-id (buffer-substring (point-at-bol)
(point-at-eol)))
(forward-line 1)
(setq now-playing-url (buffer-substring (point-at-bol)
(point-at-eol)))
(forward-line 1)
(setq submission-url (buffer-substring (point-at-bol)
(point-at-eol)))
(when (or (= 0 (length session-id))
(= 0 (length now-playing-url))
(= 0 (length submission-url)))
(error "couldn't parse FM server response"))
(setq emms-librefm-scrobbler-session-id session-id
emms-librefm-scrobbler-now-playing-url now-playing-url
emms-librefm-scrobbler-submission-url submission-url)
(message "handshake successful")))))
(defun emms-librefm-scrobbler-handshake ()
"Perform client handshake call and handle response."
(emms-librefm-scrobbler-handle-handshake-response
(emms-librefm-scrobbler-handshake-call
emms-librefm-scrobbler-handshake-url
(emms-librefm-scrobbler--username)
(emms-librefm-scrobbler--password))))
;;; ------------------------------------------------------------------
;;; submission
;;; ------------------------------------------------------------------
(defun emms-librefm-scrobbler-make-query (track rating)
"Format the url parameters for scrobbling."
(setq rating
(cond ((equal 'love rating) "L")
((equal 'ban rating) "B")
((equal 'skip rating) "S")
(t "")))
(let ((artist (emms-track-get track 'info-artist))
(title (emms-track-get track 'info-title))
(album (or (emms-track-get track 'info-album) ""))
(track-number (emms-track-get track 'info-tracknumber))
(musicbrainz-id "")
(track-length (number-to-string
(or (emms-track-get track
'info-playing-time)
0))))
(if (and artist title)
(concat
"s=" emms-librefm-scrobbler-session-id
"&a[0]=" (url-encode-url artist)
"&t[0]=" (url-encode-url title)
"&i[0]=" (url-encode-url
(or emms-librefm-scrobbler-track-play-start-timestamp
(format-time-string "%s")))
"&o[0]=" "P"
"&r[0]=" (url-encode-url rating)
"&l[0]=" track-length
"&b[0]=" (url-encode-url album)
"&n[0]=" track-number
"&m[0]=" musicbrainz-id)
(error "Track title and artist must be known."))))
;;; ------------------------------------------------------------------
;;; asynchronous submission
;;; ------------------------------------------------------------------
(defun emms-librefm-scrobbler-get-response-status ()
"Check the HTTP header and return the body."
(let ((ok200 "HTTP/1.1 200 OK"))
(if (< (point-max) 1)
(error "No response from submission server"))
(if (not (string= ok200 (buffer-substring-no-properties (point-min) 16)))
(error "submission server not responding correctly"))
(goto-char (point-min))
(re-search-forward "\n\n")
(buffer-substring-no-properties
(point-at-bol) (point-at-eol))))
(defun emms-librefm-scrobbler-make-async-submission-call (track rating)
"Make asynchronous submission call."
(let ((flarb (emms-librefm-scrobbler-make-query track rating)))
(let* ((url-request-method "POST")
(url-request-data flarb)
(url-request-extra-headers
`(("Content-type" . "application/x-www-form-urlencoded"))))
(ignore url-request-extra-headers
url-request-data
url-request-method)
(url-retrieve emms-librefm-scrobbler-submission-url
#'emms-librefm-scrobbler-async-submission-callback
(list (cons track rating))))))
(defun emms-librefm-scrobbler-async-submission-callback (status &optional cbargs)
"Pass response of asynchronous submission call to handler."
(let ((response (emms-librefm-scrobbler-get-response-status)))
(ignore status)
;; From the API docs: This indicates that the
;; submission request was accepted for processing. It
;; does not mean that the submission was valid, but
;; only that the authentication and the form of the
;; submission was validated.
(let ((track (car cbargs)))
(cond ((string= response "OK")
(when emms-librefm-scrobbler-display-submissions
(message "Libre.fm: Submitted %s"
(emms-track-get track 'info-title))))
((string= response "BADSESSION")
(emms-librefm-scrobbler-handshake)
(emms-librefm-scrobbler-make-async-submission-call (car cbargs) (cdr cbargs)))
(t
(error "unhandled submission failure"))))))
;;; ------------------------------------------------------------------
;;; hooks
;;; ------------------------------------------------------------------
(defun emms-librefm-scrobbler-start-hook ()
(setq emms-librefm-scrobbler-track-play-start-timestamp
(format-time-string "%s")))
(defun emms-librefm-scrobbler-stop-hook ()
"Submit the track to libre.fm if it has been played for 240
seconds or half the length of the track."
(let ((current-track (emms-playlist-current-selected-track)))
(let ((track-length (emms-track-get current-track 'info-playing-time)))
(when (and track-length
;; only submit files
(eq (emms-track-type current-track) 'file))
(when (and
;; track must be longer than 30 secs
(> track-length 30)
;; track must be played for more than 240 secs or
;; half the tracks length, whichever comes first.
(> emms-playing-time (min 240 (/ track-length 2))))
(emms-librefm-scrobbler-make-async-submission-call
current-track nil))))))
(defun emms-librefm-scrobbler-enable ()
"Enable the scrobbler and submit played tracks."
(interactive)
(when (not emms-librefm-scrobbler-session-id)
(emms-librefm-scrobbler-handshake))
(add-hook 'emms-player-started-hook
'emms-librefm-scrobbler-start-hook t)
(add-hook 'emms-player-stopped-hook
'emms-librefm-scrobbler-stop-hook)
(add-hook 'emms-player-finished-hook
'emms-librefm-scrobbler-stop-hook))
(defun emms-librefm-scrobbler-disable ()
"Disable the scrobbler and don't submit played tracks."
(interactive)
(setq emms-librefm-scrobbler-session-id nil)
(remove-hook 'emms-player-started-hook
'emms-librefm-scrobbler-start-hook)
(remove-hook 'emms-player-stopped-hook
'emms-librefm-scrobbler-stop-hook)
(remove-hook 'emms-player-finished-hook
'emms-librefm-scrobbler-stop-hook))
(provide 'emms-librefm-scrobbler)
;;; emms-librefm-scrobbler.el ends here
|