02/02: services: Add 'thermald-service-type'.

[Christopher Allan Webber]

cwebber pushed a commit to branch master
in repository guix.

commit d7fa39ccec34bc223d52a04dfc3e1f756e2dfa24
Author: Christopher Allan Webber <address@hidden>
Date:   Sat May 13 19:37:02 2017 -0500

    services: Add 'thermald-service-type'.
    
    * gnu/services/pm.scm (<thermald-configuration>): New record type.
    (thermald-shepherd-service, thermald-service-type): New variables.
    * doc/guix.texi (Thermal Management): New section documenting thermald.
---
 doc/guix.texi       | 28 +++++++++++++++++++++++++++-
 gnu/services/pm.scm | 41 ++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 67 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 844f0d7..43ed051 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35,7 +35,8 @@ Copyright @copyright{} 2017 Mathieu address@hidden
 Copyright @copyright{} 2017 Federico address@hidden
 Copyright @copyright{} 2017 Carlo address@hidden
 Copyright @copyright{} 2017 Thomas address@hidden
-Copyright @copyright{} 2017 humanitiesNerd
+Copyright @copyright{} 2017 address@hidden
+Copyright @copyright{} 2017 Christopher Allan Webber
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -14617,6 +14618,31 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
+
+The @code{(gnu services pm)} module provides an interface to
+thermald, a CPU frequency scaling service which helps prevent overheating.
+
address@hidden {Scheme Variable} thermald-service-type
+This is the service type for
address@hidden://01.org/linux-thermal-daemon/, thermald}, the Linux
+Thermal Daemon, which is responsible for controlling the thermal state
+of processors and preventing overheating.
address@hidden defvr
+
address@hidden {Data Type} thermald-configuration
+Data type representing the configuration of @code{thermald-service-type}.
+
address@hidden @asis
address@hidden @code{ignore-cpuid-check?} (default: @code{#f})
+Ignore cpuid check for supported CPU models.
+
address@hidden @code{thermald} (default: @var{thermald})
+Package object of thermald.
+
address@hidden table
address@hidden deftp
+
+
 @node Miscellaneous Services
 @subsubsection Miscellaneous Services
 
diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm
index 3cefe18..d40cb99 100644
--- a/gnu/services/pm.scm
+++ b/gnu/services/pm.scm
@@ -20,6 +20,7 @@
   #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix records)
+  #:use-module (gnu packages admin)
   #:use-module (gnu packages linux)
   #:use-module (gnu services)
   #:use-module (gnu services base)
@@ -27,7 +28,10 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:export (tlp-service-type
-            tlp-configuration))
+            tlp-configuration
+
+            thermald-configuration
+            thermald-service-type))
 
 (define (uglify-field-name field-name)
   (let ((str (symbol->string field-name)))
@@ -403,3 +407,38 @@ shutdown on system startup."))
   (generate-documentation
    `((tlp-configuration ,tlp-configuration-fields))
    'tlp-configuration))
+
+
+
+;;;
+;;; thermald
+;;;
+;;; This service implements cpu scaling.  Helps prevent overheating!
+
+(define-record-type* <thermald-configuration>
+  thermald-configuration make-thermald-configuration
+  thermald-configuration?
+  (ignore-cpuid-check? thermald-ignore-cpuid-check?    ;boolean
+                       (default #f))
+  (thermald            thermald-thermald               ;package
+                       (default thermald)))
+
+(define (thermald-shepherd-service config)
+  (list
+   (shepherd-service
+    (provision '(thermald))
+    (documentation "Run thermald cpu frequency scaling.")
+    (start #~(make-forkexec-constructor
+              '(#$(file-append (thermald-thermald config) "/sbin/thermald")
+                "--no-daemon"
+                #$@(if (thermald-ignore-cpuid-check? config)
+                       '("--ignore-cpuid-check")
+                       '()))))
+    (stop #~(make-kill-destructor)))))
+
+(define thermald-service-type
+  (service-type
+   (name 'thermald)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        thermald-shepherd-service)))
+   (default-value (thermald-configuration))))