summaryrefslogtreecommitdiff
path: root/ctftilde/src/guile
diff options
context:
space:
mode:
authorW. Kosior <koszko@koszko.org>2024-05-27 12:19:19 +0200
committerW. Kosior <koszko@koszko.org>2024-05-27 12:29:59 +0200
commitee8fac8ab8529e2d105c7e55c2c9b28aefd19b46 (patch)
tree7f7559d0ba91710624eb2c76a9765587595d8153 /ctftilde/src/guile
parent2d05ae83321cdf8aa3abab6acdd69f331ef4b89a (diff)
downloadAGH-ctf-course-2024-magister.tar.gz
AGH-ctf-course-2024-magister.zip
Update and add remaining files.HEADmagister
Diffstat (limited to 'ctftilde/src/guile')
-rw-r--r--ctftilde/src/guile/ctftilde/main-site.scm84
-rw-r--r--ctftilde/src/guile/ctftilde/users.scm53
2 files changed, 103 insertions, 34 deletions
diff --git a/ctftilde/src/guile/ctftilde/main-site.scm b/ctftilde/src/guile/ctftilde/main-site.scm
index 1598ff3..fc9e6c2 100644
--- a/ctftilde/src/guile/ctftilde/main-site.scm
+++ b/ctftilde/src/guile/ctftilde/main-site.scm
@@ -93,22 +93,68 @@ and minimalism. Besides this, you can run your own website or Gemini capsule.")
package manager & operating system. And it lets the users benefit from this
tooling as well!")
- (h2 "What to do?")
+ (h2 "Unconvinced?")
(p "If you're not yet sure you want to join, take time to browse other
user's tilde websites/capsules and see how they spend time here. You might
also want to familiarize yourself with GNU Guix. Once you're ready, jump to our
-registration page.")
+registration page. You might also want to read our short \"First Steps\"
+article.")
(ul
(li (a (@ (href "https://guix.gnu.org/"))
"GNU Guix website"))
(li (a (@ (href "https://ctftilde.koszko.org/registration"))
- "Registration page")))
+ "Registration page"))
+ (li (a (@ (href "https://ctftilde.koszko.org/first-steps"))
+ "First Steps")))
(h2 "Our users' blogs")
+ (p "(please send an email to admin@ctftilde.koszko.org if you want to have
+your blog listed here)")
(ul
(li (a (@ (href "./~abdul"))
"~abdul"))))))
+(cant:define-endpoint %endset first-steps
+ ("first-steps") '()
+ (contents->html
+ '((h1 "First steps")
+ (p "So, you've made an account through the registration page and can now
+connect via SSH. You're surely wondering where to put your HTML pages to have
+them served, etc…")
+ (ul
+ (li (a (@ (href "https://ctftilde.koszko.org/registration"))
+ "Registration page")))
+
+ (h2 "HTTP user directory")
+ (p "Your very own HTTP directory is at")
+ (pre "/srv/http/users/$YOUR_USERNAME/")
+ (p "It is served by Apache. Whatever you put there, will be viewable at")
+ (pre "https://ctftilde.koszko.org/~$YOUR_USERNAME/")
+ (p "Btw, if you like simple and lean web pages, feel free to load the
+minimal CC0-licensed stylesheet at")
+ (pre "https://ctftilde.koszko.org/resources/ctftilde.css")
+ (p "into your HTML documents :)")
+
+ (h2 "Gemini user directory")
+ (p "Don't you also feel that \"Web\" is sometimes too much? Wouldn't you
+love to let others view your blog (or whatever you publish) using a friendlier
+technology? Here's how to: put your files under")
+ (pre "/srv/gemini-users/$YOUR_USERNAME/")
+ (p "They will immediately become available under")
+ (pre "gemini://ctftilde.koszko.org/~$YOUR_USERNAME")
+ (p "Make sure not to miss gemtext, the minimal markup language desined for
+Gemini.")
+ (ul
+ (li (a (@ (href "https://geminiprotocol.net/"))
+ "Project Gemini website"))
+ (li (a (@ (href "gemini://geminiprotocol.net/"))
+ "Project Gemini capsule (over the gemini protocol)")))
+
+ (h2 "Cron")
+ (p "We've made the effort to have a working")
+ (pre "crontab")
+ (p "command. Use it as you would on any GNU+Linux distro!"))))
+
(define query-param-regex
(make-regexp "^([^=]+)(=(.*))?"))
@@ -172,7 +218,8 @@ registration page.")
(and (not (regexp-exec start-with-lowercase-regex username))
"Username must start with a lowercase letter."))
,(lambda _
- (and (false-if-exception (getpwnam username))
+ (and (false-if-exception (getpwnam (format #f "ctftilde-~a"
+ username)))
"This username is unavailable."))))
("password"
@@ -192,7 +239,7 @@ registration page.")
(and (not (regexp-exec email-regex email))
"Provided email is not valid.")))))))
-(cant:define-endpoint %endset main-page
+(cant:define-endpoint %endset registration-page
("registration") '()
(define legal-POST?
@@ -216,21 +263,24 @@ registration page.")
(cond
((and legal-POST? (eq? '() params-mistakes))
- (write (list (format #f "ctftilde-~a" (assoc-ref params "username"))
- (encrypt-password (assoc-ref params "password")))
- (%daemon-write-port))
+ (let ((username (format #f "ctftilde-~a" (assoc-ref params "username"))))
- (contents->html
- (match (read (%daemon-read-port))
+ (write (list username (encrypt-password (assoc-ref params "password")))
+ (%daemon-write-port))
+
+ (contents->html
+ (match (read (%daemon-read-port))
- ('(ok)
- `((h1 "Done")
- (p ,(format #f "Try connecting via ssh to ~a@ctftilde.koszko.org."
- (assoc-ref params "username")))))
+ ('(ok)
+ `((h1 "Done")
+ (p ,(format #f "Try connecting via ssh to ~a@ctftilde.koszko.org."
+ username))
+ (p "Also, please don't abuse our server's resources. Let others use
+the platform, too :)")))
- (_
- `((h1 "Ooops!")
- (p "Something went wrong X("))))))
+ (_
+ `((h1 "Ooops!")
+ (p "Something went wrong X(")))))))
(else
(contents->html
diff --git a/ctftilde/src/guile/ctftilde/users.scm b/ctftilde/src/guile/ctftilde/users.scm
index 3d17362..aaaae51 100644
--- a/ctftilde/src/guile/ctftilde/users.scm
+++ b/ctftilde/src/guile/ctftilde/users.scm
@@ -6,6 +6,7 @@
#:use-module ((ice-9 exceptions) #:select
(raise-exception with-exception-handler))
#:use-module ((ice-9 match) #:select (match))
+ #:use-module ((ice-9 regex) #:select (match:substring))
#:use-module ((system repl debug) #:select (terminal-width))
@@ -61,6 +62,18 @@
(dynamic-wind noop loop (cut closedir dir))))
+(define ctftilde-user-regex
+ (make-regexp "^ctftilde-(.*)"))
+
+(define (strip-ctftilde username)
+ (match (regexp-exec ctftilde-user-regex username)
+
+ (#f
+ username)
+
+ ((= (cut match:substring <> 1) stripped-username)
+ stripped-username)))
+
(define (*delete-user username)
@@ -74,8 +87,10 @@
(false-if-exception (delete-file creation-file))
(system* "userdel" "-rf" username)
- (system* "rm" "-rf" (string-append "/srv/gemini-users/" username))
- (system* "rm" "-rf" (string-append "/srv/http-users/" username))
+ (system* "rm" "-rf" (string-append "/srv/gemini-users/"
+ (strip-ctftilde username)))
+ (system* "rm" "-rf" (string-append "/srv/http-users/"
+ (strip-ctftilde username)))
(sync)
(false-if-exception (delete-file deletion-file))
(sync)))
@@ -94,21 +109,25 @@
(make-regexp "^[a-zA-Z][a-zA-Z0-9-]*$"))
(define* (*make-user username encrypted-password #:optional recreated-user-uid)
+ (define home-dir
+ (string-append "/home/ctftilde/" (strip-ctftilde username)))
+
(define (add-user)
- (when (> (apply system*
- `("useradd"
- "--shell" "/run/current-system/profile/bin/bash"
- "--home-dir" ,(string-append "/home/ctftilde/" username)
- "--create-home"
- ,@(or (and=> recreated-user-uid
- (compose (cut list "--uid" <>)
- number->string))
- '())
- "--gid" "hackers"
- "-p" ,encrypted-password
- ,username))
- 0)
- (raise-exception "User could not be added.")))
+ (if (> (apply system*
+ `("useradd"
+ "--shell" "/run/current-system/profile/bin/bash"
+ "--home-dir" ,home-dir
+ "--create-home"
+ ,@(or (and=> recreated-user-uid
+ (compose (cut list "--uid" <>)
+ number->string))
+ '())
+ "--gid" "hackers"
+ "-p" ,encrypted-password
+ ,username))
+ 0)
+ (raise-exception "User could not be added.")
+ (chmod home-dir #o700)))
(define (add-user-files)
(define user
@@ -116,7 +135,7 @@
(define (make-user-file path-format what)
(define path
- (format #f path-format username))
+ (format #f path-format (strip-ctftilde username)))
(unless (file-exists? path)
(match what