/src/yolk-static_content.adb
Ada | 438 lines | 299 code | 60 blank | 79 comment | 12 complexity | 31e1de1400b8e4521c66b37961761dd1 MD5 | raw file
1------------------------------------------------------------------------------- 2-- -- 3-- Copyright (C) 2010-, Thomas Løcke -- 4-- -- 5-- This library is free software; you can redistribute it and/or modify -- 6-- it under terms of the GNU General Public License as published by the -- 7-- Free Software Foundation; either version 3, or (at your option) any -- 8-- later version. This library is distributed in the hope that it will be -- 9-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 11-- -- 12-- As a special exception under Section 7 of GPL version 3, you are -- 13-- granted additional permissions described in the GCC Runtime Library -- 14-- Exception, version 3.1, as published by the Free Software Foundation. -- 15-- -- 16-- You should have received a copy of the GNU General Public License and -- 17-- a copy of the GCC Runtime Library Exception along with this program; -- 18-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 19-- <http://www.gnu.org/licenses/>. -- 20-- -- 21------------------------------------------------------------------------------- 22 23with Ada.Calendar; 24with Ada.Directories; 25with Ada.Streams.Stream_IO; 26with Ada.Strings.Unbounded; 27with AWS.MIME; 28with ZLib; 29with Yolk.Configuration; 30with Yolk.Not_Found; 31with Yolk.Log; 32 33package body Yolk.Static_Content is 34 35 protected GZip_And_Cache is 36 procedure Do_It 37 (GZ_Resource : in String; 38 Resource : in String); 39 -- If a compressable resource is requested and it doesn't yet exist, 40 -- then this procedure takes care of GZip'ing the Resource and saving 41 -- it to disk as a .gz file. 42 43 function Get_Cache_Option 44 return AWS.Messages.Cache_Option; 45 -- Return the Cache_Option object for the resource. 46 47 procedure Initialize; 48 -- Delete and re-create the Compressed_Cache_Directory. 49 50 procedure Set_Cache_Options 51 (No_Cache : in Boolean := False; 52 No_Store : in Boolean := False; 53 No_Transform : in Boolean := False; 54 Max_Age : in AWS.Messages.Delta_Seconds := 86400; 55 S_Max_Age : in AWS.Messages.Delta_Seconds := 56 AWS.Messages.Unset; 57 Public : in Boolean := False; 58 Must_Revalidate : in Boolean := True; 59 Proxy_Revalidate : in Boolean := False); 60 -- Set the Cache_Data objects. 61 private 62 Cache_Options : Ada.Strings.Unbounded.Unbounded_String; 63 end GZip_And_Cache; 64 -- Handle GZip'ing, saving and deletion of compressable resources. This is 65 -- done in a protected object so we don't get multiple threads all trying 66 -- to save/delete the same resources at the same time. 67 68 function Good_Age 69 (Resource : in String) 70 return Boolean; 71 -- Return True if the age of Resource is younger than the configuration 72 -- parameter Compressed_Max_Age. If Compressed_Max_Age is 0, then always 73 -- return True. 74 75 -------------------- 76 -- Compressable -- 77 -------------------- 78 79 function Compressable 80 (Request : in AWS.Status.Data) 81 return AWS.Response.Data 82 is 83 use Ada.Directories; 84 use AWS.Messages; 85 use AWS.Status; 86 use Yolk.Configuration; 87 use Yolk.Log; 88 89 GZ_Resource : constant String := 90 Config.Get (Compressed_Static_Content_Cache) 91 & URI (Request) & ".gz"; 92 -- The path to the GZipped resource. 93 94 Resource : constant String := Config.Get (WWW_Root) & URI (Request); 95 -- The path to the requested resource. 96 97 MIME_Type : constant String := AWS.MIME.Content_Type (Resource); 98 Minimum_File_Size : constant File_Size := 99 File_Size (Integer'(Config.Get 100 (Compress_Static_Content_Minimum_File_Size))); 101 begin 102 if not Exists (Resource) 103 or else Kind (Resource) /= Ordinary_File 104 then 105 return Yolk.Not_Found.Generate (Request); 106 end if; 107 108 if Is_Supported (Request, GZip) then 109 if Exists (GZ_Resource) 110 and then Kind (GZ_Resource) = Ordinary_File 111 then 112 if Good_Age (Resource => GZ_Resource) then 113 return AWS.Response.File 114 (Content_Type => MIME_Type, 115 Filename => GZ_Resource, 116 Encoding => GZip, 117 Cache_Control => GZip_And_Cache.Get_Cache_Option); 118 else 119 Delete_File (GZ_Resource); 120 end if; 121 elsif Exists (GZ_Resource) 122 and then Kind (GZ_Resource) /= Ordinary_File 123 then 124 -- Not so good. Log to ERROR trace and return un-compressed 125 -- content. 126 Trace 127 (Handle => Error, 128 Message => GZ_Resource 129 & " exists and is not an ordinary file"); 130 131 return AWS.Response.File 132 (Content_Type => MIME_Type, 133 Filename => Resource, 134 Cache_Control => GZip_And_Cache.Get_Cache_Option); 135 end if; 136 137 if Size (Resource) > Minimum_File_Size then 138 GZip_And_Cache.Do_It (GZ_Resource => GZ_Resource, 139 Resource => Resource); 140 141 return AWS.Response.File 142 (Content_Type => MIME_Type, 143 Filename => GZ_Resource, 144 Encoding => GZip, 145 Cache_Control => GZip_And_Cache.Get_Cache_Option); 146 end if; 147 end if; 148 149 return AWS.Response.File 150 (Content_Type => MIME_Type, 151 Filename => Resource, 152 Cache_Control => GZip_And_Cache.Get_Cache_Option); 153 end Compressable; 154 155 ---------------- 156 -- Good_Age -- 157 ---------------- 158 159 function Good_Age 160 (Resource : in String) 161 return Boolean 162 is 163 use Ada.Calendar; 164 use Ada.Directories; 165 use Yolk.Configuration; 166 167 Max_Age : constant Natural := 168 Config.Get (Compressed_Static_Content_Max_Age); 169 begin 170 if Max_Age = 0 then 171 return True; 172 end if; 173 174 if 175 Clock - Modification_Time (Resource) > Duration (Max_Age) 176 then 177 return False; 178 end if; 179 180 return True; 181 end Good_Age; 182 183 ---------------------- 184 -- GZip_And_Cache -- 185 ---------------------- 186 187 protected body GZip_And_Cache is 188 procedure Do_It 189 (GZ_Resource : in String; 190 Resource : in String) 191 is 192 use Ada.Directories; 193 194 Cache_Dir : constant String := Containing_Directory (GZ_Resource); 195 begin 196 if Exists (GZ_Resource) then 197 return; 198 -- We only need to continue if the GZ_Resource doesn't exist. It 199 -- might not have existed when Do_It was called, but the previous 200 -- Do_It call might've created it. So if it now exists, we simply 201 -- return. 202 end if; 203 204 if not Exists (Cache_Dir) then 205 Create_Path (Cache_Dir); 206 end if; 207 208 Compress_File : 209 declare 210 File_In : Ada.Streams.Stream_IO.File_Type; 211 File_Out : Ada.Streams.Stream_IO.File_Type; 212 Filter : ZLib.Filter_Type; 213 214 procedure Data_Read 215 (Item : out Ada.Streams.Stream_Element_Array; 216 Last : out Ada.Streams.Stream_Element_Offset); 217 -- Read data from File_In. 218 219 procedure Data_Write 220 (Item : in Ada.Streams.Stream_Element_Array); 221 -- Write data to File_Out. 222 223 procedure Translate is new ZLib.Generic_Translate 224 (Data_In => Data_Read, 225 Data_Out => Data_Write); 226 -- Do the actual compression. Use Data_Read to read from File_In 227 -- and Data_Write to write the compressed content to File_Out. 228 229 ----------------- 230 -- Data_Read -- 231 ----------------- 232 233 procedure Data_Read 234 (Item : out Ada.Streams.Stream_Element_Array; 235 Last : out Ada.Streams.Stream_Element_Offset) 236 is 237 begin 238 Ada.Streams.Stream_IO.Read 239 (File => File_In, 240 Item => Item, 241 Last => Last); 242 end Data_Read; 243 244 ---------------- 245 -- Data_Out -- 246 ---------------- 247 248 procedure Data_Write 249 (Item : in Ada.Streams.Stream_Element_Array) 250 is 251 begin 252 Ada.Streams.Stream_IO.Write (File => File_Out, 253 Item => Item); 254 end Data_Write; 255 begin 256 Ada.Streams.Stream_IO.Open 257 (File => File_In, 258 Mode => Ada.Streams.Stream_IO.In_File, 259 Name => Resource); 260 261 Ada.Streams.Stream_IO.Create 262 (File => File_Out, 263 Mode => Ada.Streams.Stream_IO.Out_File, 264 Name => GZ_Resource); 265 266 ZLib.Deflate_Init 267 (Filter => Filter, 268 Level => ZLib.Best_Compression, 269 Header => ZLib.GZip); 270 271 Translate (Filter); 272 273 ZLib.Close (Filter); 274 275 Ada.Streams.Stream_IO.Close (File => File_In); 276 Ada.Streams.Stream_IO.Close (File => File_Out); 277 end Compress_File; 278 end Do_It; 279 280 ------------------------ 281 -- Get_Cache_Option -- 282 ------------------------ 283 284 function Get_Cache_Option 285 return AWS.Messages.Cache_Option 286 is 287 use Ada.Strings.Unbounded; 288 begin 289 return AWS.Messages.Cache_Option (To_String (Cache_Options)); 290 end Get_Cache_Option; 291 292 ------------------ 293 -- Initialize -- 294 ------------------ 295 296 procedure Initialize 297 is 298 use Ada.Directories; 299 use Yolk.Configuration; 300 use Yolk.Log; 301 begin 302 if Exists (Config.Get (Compressed_Static_Content_Cache)) 303 and then 304 Kind (Config.Get (Compressed_Static_Content_Cache)) = Directory 305 then 306 Delete_Tree 307 (Directory => Config.Get (Compressed_Static_Content_Cache)); 308 309 Trace (Info, 310 Config.Get (Compressed_Static_Content_Cache) 311 & " found and deleted"); 312 end if; 313 314 Create_Path 315 (New_Directory => Config.Get (Compressed_Static_Content_Cache)); 316 317 Trace (Info, 318 Config.Get (Compressed_Static_Content_Cache) 319 & " created"); 320 end Initialize; 321 322 ------------------------- 323 -- Set_Cache_Options -- 324 ------------------------- 325 326 procedure Set_Cache_Options 327 (No_Cache : in Boolean := False; 328 No_Store : in Boolean := False; 329 No_Transform : in Boolean := False; 330 Max_Age : in AWS.Messages.Delta_Seconds := 86400; 331 S_Max_Age : in AWS.Messages.Delta_Seconds := 332 AWS.Messages.Unset; 333 Public : in Boolean := False; 334 Must_Revalidate : in Boolean := True; 335 Proxy_Revalidate : in Boolean := False) 336 is 337 use Ada.Strings.Unbounded; 338 339 Cache_Data : AWS.Messages.Cache_Data (CKind => AWS.Messages.Response); 340 begin 341 Cache_Data.No_Cache := No_Cache; 342 Cache_Data.No_Store := No_Store; 343 Cache_Data.No_Transform := No_Transform; 344 Cache_Data.Max_Age := Max_Age; 345 Cache_Data.S_Max_Age := S_Max_Age; 346 Cache_Data.Public := Public; 347 Cache_Data.Must_Revalidate := Must_Revalidate; 348 Cache_Data.Proxy_Revalidate := Proxy_Revalidate; 349 350 Cache_Options := To_Unbounded_String 351 (String (AWS.Messages.To_Cache_Option (Cache_Data))); 352 end Set_Cache_Options; 353 end GZip_And_Cache; 354 355 ------------------------ 356 -- Non_Compressable -- 357 ------------------------ 358 359 function Non_Compressable 360 (Request : in AWS.Status.Data) 361 return AWS.Response.Data 362 is 363 use Ada.Directories; 364 use AWS.MIME; 365 use AWS.Status; 366 use Yolk.Configuration; 367 368 Resource : constant String := Config.Get (WWW_Root) & URI (Request); 369 -- The path to the requested resource. 370 begin 371 if not Exists (Resource) 372 or else Kind (Resource) /= Ordinary_File 373 then 374 return Yolk.Not_Found.Generate (Request); 375 end if; 376 377 return AWS.Response.File 378 (Content_Type => Content_Type (Resource), 379 Filename => Resource, 380 Cache_Control => GZip_And_Cache.Get_Cache_Option); 381 end Non_Compressable; 382 383 ------------------------- 384 -- Set_Cache_Options -- 385 ------------------------- 386 387 procedure Set_Cache_Options 388 (No_Cache : in Boolean := False; 389 No_Store : in Boolean := False; 390 No_Transform : in Boolean := False; 391 Max_Age : in AWS.Messages.Delta_Seconds := 86400; 392 S_Max_Age : in AWS.Messages.Delta_Seconds := AWS.Messages.Unset; 393 Public : in Boolean := False; 394 Must_Revalidate : in Boolean := True; 395 Proxy_Revalidate : in Boolean := False) 396 is 397 begin 398 GZip_And_Cache.Set_Cache_Options 399 (No_Cache => No_Cache, 400 No_Store => No_Store, 401 No_Transform => No_Transform, 402 Max_Age => Max_Age, 403 S_Max_Age => S_Max_Age, 404 Public => Public, 405 Must_Revalidate => Must_Revalidate, 406 Proxy_Revalidate => Proxy_Revalidate); 407 end Set_Cache_Options; 408 409 ---------------------------------- 410 -- Static_Content_Cache_Setup -- 411 ---------------------------------- 412 413 procedure Static_Content_Cache_Setup 414 (No_Cache : in Boolean := False; 415 No_Store : in Boolean := False; 416 No_Transform : in Boolean := False; 417 Max_Age : in AWS.Messages.Delta_Seconds := 86400; 418 S_Max_Age : in AWS.Messages.Delta_Seconds := AWS.Messages.Unset; 419 Public : in Boolean := False; 420 Must_Revalidate : in Boolean := True; 421 Proxy_Revalidate : in Boolean := False) 422 is 423 use AWS.Messages; 424 begin 425 GZip_And_Cache.Initialize; 426 427 GZip_And_Cache.Set_Cache_Options 428 (No_Cache => No_Cache, 429 No_Store => No_Store, 430 No_Transform => No_Transform, 431 Max_Age => Max_Age, 432 S_Max_Age => S_Max_Age, 433 Public => Public, 434 Must_Revalidate => Must_Revalidate, 435 Proxy_Revalidate => Proxy_Revalidate); 436 end Static_Content_Cache_Setup; 437 438end Yolk.Static_Content;