blob: bfab2af672b741a5aedb6b0e228d1daa139c301a (
plain) (
tree)
|
|
;;; emms-librefm-stream.el --- Libre.FM streaming -*- 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.
;;; Code:
(require 'xml)
(require 'emms-playlist-mode)
(require 'emms-librefm-scrobbler)
(defvar emms-librefm-stream-host-url
"alpha.libre.fm"
"URL for the streaming host")
(defvar emms-librefm-stream-host-base-path
""
"URL for the streaming host base path")
(defvar emms-librefm-stream-session-id
""
"Session ID for radio.")
(defvar emms-librefm-stream-debug
""
"Temporary debug information.")
(defvar emms-librefm-stream-station-name
""
"Last station name tuned to.")
(defvar emms-librefm-stream-emms-tracklist
""
"List of tracks for streaming.")
(defvar emms-librefm-stream-playlist-buffer-name
"*Emms GNU FM*"
"Name for non-interactive Emms GNU FM buffer.")
(defvar emms-librefm-stream-playlist-buffer nil
"Non-interactive Emms GNU FM buffer.")
(defvar emms-librefm-stream-connect-method "https://"
"Method of connecting to server.")
;;; ------------------------------------------------------------------
;;; HTTP
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-assert-http ()
"Assert a sane HTTP response from the server.
This function must be called inside the response buffer. Leaves
point after the HTTP headers."
(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")))
;;; ------------------------------------------------------------------
;;; radio handshake
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-tune-handshake-string ()
"Create the tune handshake string."
(let ((username (emms-librefm-scrobbler--username))
(password (emms-librefm-scrobbler--password)))
(let ((url (concat emms-librefm-stream-connect-method
emms-librefm-stream-host-url
"/radio/handshake.php?"
"version=1.3.0.58" "&"
"platform=linux" "&"
"username=" (url-encode-url username) "&"
"passwordmd5=" (md5 password) "&"
"language=en")))
url)))
(defun emms-librefm-stream-tune-handshake-call ()
"Make the tune handshake call."
(let ((url-request-method "POST"))
(ignore url-request-method)
(let ((response
(url-retrieve-synchronously
(emms-librefm-stream-tune-handshake-string))))
(setq emms-librefm-stream-debug
(with-current-buffer response
(buffer-substring-no-properties (point-min)
(point-max))))
response)))
(defun emms-librefm-stream-handle-tune-handshake-response (resbuf)
"Handle the tune handshake server response."
(when (not (bufferp resbuf))
(error "response not a buffer"))
(with-current-buffer resbuf
(emms-librefm-stream-assert-http)
(let (radio-session-id
base-url
base-path
(start (point)))
(if (re-search-forward "^session=\\(.*\\)$" (point-max) t)
(setq radio-session-id (match-string-no-properties 1))
(error "no radio session ID from server"))
(goto-char start)
(if (re-search-forward "^base_url=\\(.*\\)$" (point-max) t)
(setq base-url (match-string-no-properties 1))
(error "no base url from server"))
(goto-char start)
(if (re-search-forward "^base_path=\\(.*\\)$" (point-max) t)
(setq base-path (match-string-no-properties 1))
(error "no base path from server"))
(setq emms-librefm-stream-session-id radio-session-id
emms-librefm-stream-host-url base-url
emms-librefm-stream-host-base-path base-path))
(message "radio handshake successful")))
(defun emms-librefm-stream-tune-handshake ()
"Make and handle the tune handshake."
(emms-librefm-stream-handle-tune-handshake-response
(emms-librefm-stream-tune-handshake-call)))
;;; ------------------------------------------------------------------
;;; tuning
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-tune-string (session-id station)
"Create the tune string."
(when (not session-id)
(error "null session id"))
(when (not station)
(error "null station"))
(let ((url (concat emms-librefm-stream-connect-method
emms-librefm-stream-host-url
emms-librefm-stream-host-base-path
"/adjust.php?"
"session=" session-id "&"
"url=" (url-encode-url station))))
url))
(defun emms-librefm-stream-tune-call (session-id station)
"Make the tune call."
(let ((url-request-method "POST"))
(ignore url-request-method)
(let ((response
(url-retrieve-synchronously
(emms-librefm-stream-tune-string
session-id station))))
(setq emms-librefm-stream-debug
(with-current-buffer response
(buffer-substring-no-properties (point-min)
(point-max))))
response)))
(defun emms-librefm-stream-handle-tune-response (resbuf)
"Handle the tune server response."
(when (not (bufferp resbuf))
(error "response not a buffer"))
(with-current-buffer resbuf
(emms-librefm-stream-assert-http)
(let (response
stationname
(start (point)))
(if (re-search-forward "^response=\\(.*\\)$" (point-max) t)
(setq response (match-string-no-properties 1))
(error "no response status code"))
(when (not (string= response "OK"))
(error "tune response not OK"))
(goto-char start)
(if (re-search-forward "^stationname=\\(.*\\)$" (point-max) t)
(setq stationname (match-string-no-properties 1))
(error "no stationname from server"))
(setq emms-librefm-stream-station-name stationname)
(message "successfully tuned to: %s" stationname))))
(defun emms-librefm-stream-tune (station)
"Make and handle tune call."
(emms-librefm-stream-handle-tune-response
(emms-librefm-stream-tune-call
emms-librefm-stream-session-id
station)))
;;; ------------------------------------------------------------------
;;; radio.getPlaylist
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-getplaylist-string (radio-session-id)
"Create the getplaylist string."
(when (not radio-session-id)
(error "null radio session id"))
(let ((url (concat emms-librefm-stream-connect-method
emms-librefm-stream-host-url
emms-librefm-stream-host-base-path
"/xspf.php?"
"sk=" radio-session-id "&"
"discovery=0" "&"
"desktop=1.3.0.58")))
url))
(defun emms-librefm-stream-getplaylist-call (session-id)
"Make the getplaylist call."
(let ((url-request-method "POST"))
(ignore url-request-method)
(let ((response
(url-retrieve-synchronously
(emms-librefm-stream-getplaylist-string session-id))))
(setq emms-librefm-stream-debug
(with-current-buffer response
(buffer-substring-no-properties (point-min)
(point-max))))
response)))
(defun emms-librefm-stream-handle-getplaylist-response (resbuf)
"Handle the getplaylist server response."
(when (not (bufferp resbuf))
(error "response not a buffer"))
(with-current-buffer resbuf
(emms-librefm-stream-assert-http)
(xml-parse-region (point) (point-max))))
(defun emms-librefm-stream-getplaylist ()
"Make and handle radio.getPlaylist."
(emms-librefm-stream-handle-getplaylist-response
(emms-librefm-stream-getplaylist-call
emms-librefm-stream-session-id)))
;;; ------------------------------------------------------------------
;;; XSPF
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-xspf-find (tag data)
"Return the tracklist portion of PLAYLIST or nil."
(let ((tree (copy-tree data))
result)
(while (and tree (not result))
(let ((this (car tree)))
(when (and (listp this)
(eq (car this) tag))
(setq result this)))
(setq tree (cdr tree)))
result))
(defun emms-librefm-stream-xspf-tracklist (playlist)
"Return the tracklist portion of PLAYLIST or nil."
(emms-librefm-stream-xspf-find 'trackList (car playlist)))
(defun emms-librefm-stream-xspf-get (tag track)
"Return the data associated with TAG in TRACK."
(nth 2 (emms-librefm-stream-xspf-find tag track)))
(defun emms-librefm-stream-xspf-convert-track (track)
"Convert TRACK to an Emms track."
(let ((location (emms-librefm-stream-xspf-get 'location track))
(title (emms-librefm-stream-xspf-get 'title track))
(album (emms-librefm-stream-xspf-get 'album track))
(creator (emms-librefm-stream-xspf-get 'creator track))
(duration (emms-librefm-stream-xspf-get 'duration track)))
(let ((emms-track (emms-dictionary '*track*)))
(emms-track-set emms-track 'name location)
(emms-track-set emms-track 'info-artist creator)
(emms-track-set emms-track 'info-title title)
(emms-track-set emms-track 'info-album album)
(emms-track-set emms-track 'info-playing-time
(/ (string-to-number duration)
1000))
(emms-track-set emms-track 'type 'url)
emms-track)))
(defun emms-librefm-stream-xspf-convert-tracklist (tracklist)
"Convert TRACKLIST to a list of Emms tracks."
(let (tracks)
(mapc
#'(lambda (e)
(when (and (listp e)
(eq 'track (car e)))
(setq tracks
(append tracks
`(,(emms-librefm-stream-xspf-convert-track e))))))
tracklist)
tracks))
;;; ------------------------------------------------------------------
;;; stream
;;; ------------------------------------------------------------------
(defun emms-librefm-stream-set-librefm-playlist-buffer ()
"Setup the GNU FM buffer and make it `emms-playlist-buffer'."
(when (not (buffer-live-p emms-librefm-stream-playlist-buffer))
(setq emms-librefm-stream-playlist-buffer
(emms-playlist-new
emms-librefm-stream-playlist-buffer-name)))
(setq emms-playlist-buffer emms-librefm-stream-playlist-buffer))
(defun emms-librefm-stream-queue ()
"Queue streaming tracks."
(let ((tracklist
(emms-librefm-stream-xspf-tracklist
(emms-librefm-stream-getplaylist))))
(when (not tracklist)
(setq emms-librefm-stream-emms-tracklist nil)
(error "could not find tracklist"))
(setq emms-librefm-stream-emms-tracklist
(emms-librefm-stream-xspf-convert-tracklist tracklist))
(emms-librefm-stream-set-librefm-playlist-buffer)
(with-current-emms-playlist
(goto-char (point-max))
(save-excursion
(mapc
#'(lambda (track)
(emms-playlist-insert-track track))
emms-librefm-stream-emms-tracklist)))))
(defun emms-librefm-stream-queue-loader ()
"Queue more streaming music if needed."
(with-current-emms-playlist
(goto-char (if emms-playlist-mode-selected-overlay
(overlay-start emms-playlist-mode-selected-overlay)
(point-min)))
(when (and (eq (current-buffer)
emms-librefm-stream-playlist-buffer)
(not (next-single-property-change (point-at-eol)
'emms-track)))
(emms-librefm-stream-queue))))
(defun emms-librefm-stream (station)
"Stream STATION from a GNU FM server."
(interactive "sEnter station URL: ")
(when (not (stringp station))
(error "bad argument"))
(add-hook 'emms-player-finished-hook
'emms-librefm-stream-queue-loader)
(emms-librefm-stream-tune-handshake)
(emms-librefm-stream-tune station)
(message "tuned to %s, getting playlist..."
emms-librefm-stream-station-name)
(emms-librefm-stream-queue)
(with-current-emms-playlist
(emms-playlist-mode-play-current-track)))
(provide 'emms-librefm-stream)
;;; emms-librefm-stream.el ends here
|